wip

LICENSE

@@ -0,0 +1,31 @@
+Copyright (c) 2023, 2024
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of  nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+

hbs2-git/hbs2-git-dashboard/src/HBS2/Git/DashBoard/Prelude.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE PatternSynonyms #-}
 module HBS2.Git.DashBoard.Prelude
   ( module HBS2.Git.DashBoard.Prelude
   , module HBS2.Prelude.Plated
@@ -18,6 +19,7 @@ module HBS2.Git.DashBoard.Prelude
   , module UnliftIO
   , module Codec.Serialise
   , GitRef(..), GitHash(..), GitObjectType(..)
+  , pattern SignPubKeyLike
   , qc, q
   ) where
 
@@ -31,6 +33,7 @@ import HBS2.Merkle
 import HBS2.System.Logger.Simple.ANSI as Logger
 import HBS2.Misc.PrettyStuff as Logger
 
+import HBS2.Net.Auth.Credentials
 
 import HBS2.Peer.RPC.API.RefChan as API
 import HBS2.Peer.RPC.API.RefLog  as API

hbs2-git/hbs2-git-dashboard/src/HBS2/Git/Web/Html/Root.hs

@@ -349,13 +349,13 @@ dashboardRootPage = rootPage do
         div_ [class_ "info-block"] $ small_ "Всякая разная рандомная информация хрен знает, что тут пока выводить"
 
       div_ [class_ "content"] do
-        
+
         section_ do
           h2_ "Git repositories"
           form_ [role_ "search"] do
             input_ [name_ "search", type_ "search"]
             input_ [type_ "submit", value_ "Search"]
-                      
+
         section_ do
 
           for_ items $ \it@RepoListItem{..} -> do
@@ -913,6 +913,12 @@ asGitHash  = \case
   LitStrVal s -> fromStringMay (Text.unpack s)
   _ -> Nothing
 
+
+pattern FixmeRefChanP :: forall {c} . PubKey Sign HBS2Basic -> Syntax c
+pattern FixmeRefChanP x <- ListVal [ SymbolVal "fixme:"
+                                   , ListVal [ SymbolVal "refchan", SignPubKeyLike x
+                                   ]]
+
 repoPage :: (MonadIO m, DashBoardPerks m, MonadReader DashBoardEnv m)
          => RepoPageTabs
          -> LWWRefKey 'HBS2Basic
@@ -937,6 +943,8 @@ repoPage tab lww params = rootPage do
   let public = headMay [ s | ListVal [ SymbolVal "public:", SymbolVal (Id s) ] <- meta ]
   let pinned = [ (name,r) | ListVal [ SymbolVal "pinned:", r@(PinnedRefBlob _ name _) ] <- meta ] & take 5
 
+  let fixme  = headMay [ x | FixmeRefChanP x <- meta ]
+
   debug $ red "META" <+> pretty meta
 
   main_ [class_ "container-fluid"] do
@@ -971,6 +979,12 @@ repoPage tab lww params = rootPage do
                   span_ [class_ "inline-icon-wrapper"] $ svgIcon IconLicense
                   "Manifest"
 
+            for_ fixme $ \_ -> do
+              li_ $ small_ do
+                a_ [class_ "secondary"] do
+                  span_ [class_ "inline-icon-wrapper"] $ svgIcon IconLicense
+                  "Issues"
+
             when (rlRepoForks > 0) do
               li_ $ small_ do
                 a_ [class_ "secondary"