feat: logging

spago.yaml

@@ -22,7 +22,7 @@ workspace:
   extra_packages:
     fetch:
       git: 'https://git.orionkindel.com/thunderstrike/purescript-fetch.git'
-      ref: '01f505d'
+      ref: 'd74d343'
       dependencies:
         - aff
         - aff-promise

src/Gitea.Config.purs

@@ -1,6 +1,9 @@
 module Gitea.Config where
 
+import Prelude
+
 import Data.URL (URL)
+import Effect (Effect)
 import Gitea.Auth (Authenticated)
 
-type Config = { baseURI :: URL, auth :: Authenticated }
+type Config = { logTrace :: String -> Effect Unit, log :: String -> Effect Unit, baseURI :: URL, auth :: Authenticated }

src/Gitea.Error.purs

@@ -17,8 +17,11 @@ data Error
   | EValidation { message :: String, url :: String }
 
 derive instance Generic Error _
-instance Eq Error where eq = genericEq
-instance Show Error where show = genericShow
+instance Eq Error where
+  eq = genericEq
+
+instance Show Error where
+  show = genericShow
 
 guardStatusOk :: forall m. MonadThrow Error m => MonadAff m => HTTP.Response -> m Unit
 guardStatusOk rep = do

src/Gitea.HTTP.purs

@@ -0,0 +1,45 @@
+module Gitea.HTTP where
+
+import Prelude
+
+import Control.Monad.Error.Class (catchError)
+import Control.Monad.Reader (ask)
+import Data.ArrayBuffer.ArrayBuffer as ArrayBuffer
+import Data.Foldable (intercalate)
+import Data.Maybe (maybe)
+import Data.Tuple.Nested ((/\))
+import Data.URL as URL
+import Effect.Aff.Class (class MonadAff)
+import Effect.Class (liftEffect)
+import Gitea.Auth as Auth
+import Gitea.Trans (GiteaT(..))
+import HTTP (class Request)
+import HTTP as HTTP
+import HTTP.Header (Headers(..))
+import HTTP.Request (bodyToRaw, rawRequestBodySize, requestBody, requestHeaders, requestMethod, requestUrl)
+import HTTP.Response (Response)
+import HTTP.Response as Rep
+
+fetch :: forall m a. MonadAff m => Request a => a -> GiteaT m Response
+fetch req = do
+  { logTrace, auth } <- ask
+  method <- requestMethod req
+  url <- requestUrl req
+  reqHeaders <- requestHeaders req
+  authHeaders <- liftEffect $ Auth.headers auth
+  let headers = reqHeaders <> authHeaders
+
+  body <- requestBody req
+  rawBody <- bodyToRaw body
+  bodySize <- liftEffect $ maybe (pure 0) rawRequestBodySize rawBody
+
+  liftEffect $ logTrace $ intercalate " " $ [ show method, show bodySize <> "b", URL.toString url ]
+
+  rep <- HTTP.fetch $ method /\ url /\ body /\ headers
+
+  status <- Rep.status rep
+  statusText <- Rep.statusText rep
+  repBodyDebug <- catchError (Rep.text =<< Rep.clone rep) (const $ map ((_ <> "b") <<< show <<< ArrayBuffer.byteLength) $ flip bind Rep.arrayBuffer $ Rep.clone rep)
+  liftEffect $ logTrace $ intercalate " " $ [ show status, statusText, repBodyDebug ]
+
+  pure rep

src/Gitea.Repo.BranchProtections.purs

@@ -10,7 +10,8 @@ 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 Gitea.HTTP (fetch) as HTTP
+import HTTP (Method(..)) as HTTP
 import HTTP.Request (json) as HTTP
 import Simple.JSON (class WriteForeign)
 import Type.Row.Subset (class Subset)
@@ -23,16 +24,14 @@ branchProtectionOneURL (Username owner) (RepoName repo) (BranchProtectionName ru
 
 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
+  rep <- HTTP.fetch $ HTTP.GET /\ url
   Error.tryGetRepJSON rep
 
 list :: forall m. MonadAff m => Username -> RepoName -> GiteaT m (Array (Record BranchProtection))
 list u r = do
-  { auth } <- ask
   url <- branchProtectionURL u r
-  rep <- HTTP.fetch $ HTTP.GET /\ url /\ Auth.headers auth
+  rep <- HTTP.fetch $ HTTP.GET /\ url
   Error.tryGetRepJSON rep
 
 update
@@ -46,14 +45,12 @@ update
   -> 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
+  rep <- HTTP.fetch $ HTTP.PATCH /\ url /\ HTTP.json patch
   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
+  rep <- HTTP.fetch $ HTTP.DELETE /\ url
   Error.guardStatusOk rep

src/Gitea.Repo.Secret.purs

@@ -10,7 +10,8 @@ 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 Gitea.HTTP (fetch) as HTTP
+import HTTP (Method(..)) as HTTP
 import HTTP.Request (json) as HTTP
 
 secretsURL :: forall m. Monad m => Username -> RepoName -> SecretName -> GiteaT m URL
@@ -18,14 +19,12 @@ secretsURL (Username owner) (RepoName repo) (SecretName secret) = (\{ baseURI }
 
 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
+  rep <- HTTP.fetch $ HTTP.PUT /\ url /\ HTTP.json { "data": sv }
   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
+  rep <- HTTP.fetch $ HTTP.DELETE /\ url
   Error.guardStatusOk rep

src/Gitea.Repo.purs

@@ -7,13 +7,15 @@ import Control.Monad.Rec.Class (class MonadRec, Step(..), tailRecM)
 import Data.Array as Array
 import Data.Tuple.Nested ((/\))
 import Data.URL (URL, (/), (?), (&))
+import Data.URL as 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 Gitea.HTTP (fetch) as HTTP
+import HTTP (Method(..)) as HTTP
 import HTTP.Request (json) as HTTP
 import Node.Buffer (Buffer)
 import Node.Buffer as Buffer
@@ -42,9 +44,8 @@ orgReposURL (OrgName org) { page, limit } = (\{ baseURI } -> baseURI / "orgs" /
 
 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
+  rep <- HTTP.fetch $ HTTP.GET /\ url
   Error.tryGetRepJSON rep
 
 listForOrg :: forall m. MonadAff m => MonadRec m => OrgName -> GiteaT m (Array (Record Repo))
@@ -58,9 +59,8 @@ listForOrg o =
     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
+      rep <- HTTP.fetch $ HTTP.GET /\ url
       Error.tryGetRepJSON rep
   in
     tailRecM paginate ([] /\ 1)
@@ -75,38 +75,33 @@ update
   -> 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
+  rep <- HTTP.fetch $ HTTP.PATCH /\ url /\ HTTP.json patch
   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
+  rep <- HTTP.fetch $ HTTP.DELETE /\ url
   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
+  rep <- HTTP.fetch $ HTTP.POST /\ url /\ HTTP.json { image: b64 }
   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
+  rep <- HTTP.fetch $ HTTP.DELETE /\ url
   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
+  rep <- HTTP.fetch $ HTTP.PUT /\ url
   Error.guardStatusOk rep
 
 getTopics :: forall m. MonadAff m => MonadRec m => Username -> RepoName -> GiteaT m (Array TopicName)
@@ -117,12 +112,12 @@ getTopics owner repo =
     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
+      rep <- HTTP.fetch $ HTTP.GET /\ url
       { topics } <- Error.tryGetRepJSON @{ topics :: Array TopicName } rep
       pure topics
   in
@@ -130,14 +125,12 @@ getTopics owner repo =
 
 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
+  rep <- HTTP.fetch $ HTTP.DELETE /\ url
   Error.guardStatusOk rep
 
 setTopics :: forall m. MonadAff m => Username -> RepoName -> Array TopicName -> GiteaT m Unit
 setTopics owner repo topics = do
-  { auth } <- ask
   url <- repoTopicsURL owner repo
-  rep <- HTTP.fetch $ HTTP.PUT /\ url /\ HTTP.json { topics } /\ Auth.headers auth
+  rep <- HTTP.fetch $ HTTP.PUT /\ url /\ HTTP.json { topics }
   Error.guardStatusOk rep