mirror of
https://code.sup39.dev/repos/Wqawg
synced 2025-01-15 11:05:12 +09:00
2e72684fd5
This is such a huge patch, it's probably impossible to tell what it does by looking at the code. One thing is clear: It changes *everything* :P so here's an overview: - There are now 5 types of actors, each having its own top-level route - So projects, repos, etc. are no longer "under" sharers - Actor routes are now based on their KeyHashid, there are no "idents" anymore, i.e. URLs look random and don't contain user or repo names - No sharers anymore; people and groups are distinct entities not sharing a common namespace or anything like that - Project has been renamed to Deck and it simply means a ticket tracker; repos are no longer "under" projects - In addition to Person, Group, Repo and Deck, there's a new actor type Loom, which is a patch tracker; i.e. Repo actors don't manage MRs anymore - All C2S and S2S is temporarily disabled, because huge changes to the whole code are required and I'll do them gradually in the next patches - Since form-based actions are implemented using C2S, they're disabled as well, so Vervis is now essentially read-only - Some views have been temporarily removed, e.g. repo history and commit view - A huge set of DB migrations has been added to adapt the DB to these changes; I haven't tested them yet on a read DB so there may be errors there; I'll fix them in the next patches if I find any (probably going to test on the main instance where Vervis itself is hosted...) - Some modules got tech upgrades, e.g. LocalActor became a higher-kinded type and a similar pattern is probably relevant for several other types - There's an 'Actor' entity in the DB schema now, and all 5 actor types use it for common things like inbox and outbox - Although inbox and outbox are used only by Actor, so essentially could be removed, I haven't removed them; that's because I wonder if at some point users can have a tree of inboxes much like in email; I don't have an excuse for Outbox, but anyway, leaving them as is for now - Workflows, roles and collaborators are partially removed/unused until I figure out a sane federated way to provide these features - Since repo routes don't contain a "sharer" anymore, SSH URIs are now simpler, they already look like user@host/repo regardless of who "controls" that repo
148 lines
3.8 KiB
Haskell
148 lines
3.8 KiB
Haskell
{- This file is part of Vervis.
|
|
-
|
|
- Written in 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
|
-
|
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
|
-
|
|
- The author(s) have dedicated all copyright and related and neighboring
|
|
- rights to this software to the public domain worldwide. This software is
|
|
- distributed without any warranty.
|
|
-
|
|
- You should have received a copy of the CC0 Public Domain Dedication along
|
|
- with this software. If not, see
|
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
-}
|
|
|
|
module Yesod.Hashids
|
|
( YesodHashids (..)
|
|
, KeyHashid ()
|
|
, keyHashidText
|
|
|
|
, encodeKeyHashidPure
|
|
, getEncodeKeyHashid
|
|
, encodeKeyHashid
|
|
|
|
, decodeKeyHashidPure
|
|
, decodeKeyHashid
|
|
, decodeKeyHashidF
|
|
, decodeKeyHashidM
|
|
, decodeKeyHashidE
|
|
, decodeKeyHashid404
|
|
)
|
|
where
|
|
|
|
import Prelude hiding (fail)
|
|
|
|
import Control.Monad.Fail
|
|
import Control.Monad.Trans.Except
|
|
import Control.Monad.Trans.Maybe
|
|
import Data.Text (Text)
|
|
import Data.Text.Encoding
|
|
import Database.Persist.Class
|
|
import Database.Persist.Sql
|
|
import Web.Hashids
|
|
import Web.PathPieces
|
|
import Yesod.Core
|
|
|
|
import Yesod.MonadSite
|
|
|
|
import Web.Hashids.Local
|
|
|
|
class Yesod site => YesodHashids site where
|
|
siteHashidsContext :: site -> HashidsContext
|
|
|
|
newtype KeyHashid record = KeyHashid
|
|
{ keyHashidText :: Text
|
|
}
|
|
deriving (Eq, Ord, Read, Show)
|
|
|
|
instance PersistEntity record => PathPiece (KeyHashid record) where
|
|
fromPathPiece t = KeyHashid <$> fromPathPiece t
|
|
toPathPiece (KeyHashid t) = toPathPiece t
|
|
|
|
encodeKeyHashidPure
|
|
:: ToBackendKey SqlBackend record
|
|
=> HashidsContext -> Key record -> KeyHashid record
|
|
encodeKeyHashidPure ctx = KeyHashid . decodeUtf8 . encodeInt64 ctx . fromSqlKey
|
|
|
|
getEncodeKeyHashid
|
|
:: ( MonadSite m
|
|
, YesodHashids (SiteEnv m)
|
|
, ToBackendKey SqlBackend record
|
|
)
|
|
=> m (Key record -> KeyHashid record)
|
|
getEncodeKeyHashid = do
|
|
ctx <- asksSite siteHashidsContext
|
|
return $ encodeKeyHashidPure ctx
|
|
|
|
encodeKeyHashid
|
|
:: ( MonadSite m
|
|
, YesodHashids (SiteEnv m)
|
|
, ToBackendKey SqlBackend record
|
|
)
|
|
=> Key record
|
|
-> m (KeyHashid record)
|
|
encodeKeyHashid k = do
|
|
enc <- getEncodeKeyHashid
|
|
return $ enc k
|
|
|
|
decodeKeyHashidPure
|
|
:: ToBackendKey SqlBackend record
|
|
=> HashidsContext
|
|
-> KeyHashid record
|
|
-> Maybe (Key record)
|
|
decodeKeyHashidPure ctx (KeyHashid t) =
|
|
fmap toSqlKey $ decodeInt64 ctx $ encodeUtf8 t
|
|
|
|
decodeKeyHashid
|
|
:: ( MonadSite m
|
|
, YesodHashids (SiteEnv m)
|
|
, ToBackendKey SqlBackend record
|
|
)
|
|
=> KeyHashid record
|
|
-> m (Maybe (Key record))
|
|
decodeKeyHashid khid = do
|
|
ctx <- asksSite siteHashidsContext
|
|
return $ decodeKeyHashidPure ctx khid
|
|
|
|
decodeKeyHashidF
|
|
:: ( MonadFail m
|
|
, MonadSite m
|
|
, YesodHashids (SiteEnv m)
|
|
, ToBackendKey SqlBackend record
|
|
)
|
|
=> KeyHashid record
|
|
-> String
|
|
-> m (Key record)
|
|
decodeKeyHashidF khid e = maybe (fail e) return =<< decodeKeyHashid khid
|
|
|
|
decodeKeyHashidM
|
|
:: ( MonadSite m
|
|
, YesodHashids (SiteEnv m)
|
|
, ToBackendKey SqlBackend record
|
|
)
|
|
=> KeyHashid record
|
|
-> MaybeT m (Key record)
|
|
decodeKeyHashidM = MaybeT . decodeKeyHashid
|
|
|
|
decodeKeyHashidE
|
|
:: ( MonadSite m
|
|
, YesodHashids (SiteEnv m)
|
|
, ToBackendKey SqlBackend record
|
|
)
|
|
=> KeyHashid record
|
|
-> e
|
|
-> ExceptT e m (Key record)
|
|
decodeKeyHashidE khid e =
|
|
ExceptT $ maybe (Left e) Right <$> decodeKeyHashid khid
|
|
|
|
decodeKeyHashid404
|
|
:: ( MonadSite m
|
|
, MonadHandler m
|
|
, HandlerSite m ~ SiteEnv m
|
|
, YesodHashids (HandlerSite m)
|
|
, ToBackendKey SqlBackend record
|
|
)
|
|
=> KeyHashid record
|
|
-> m (Key record)
|
|
decodeKeyHashid404 khid = maybe notFound return =<< decodeKeyHashid khid
|