packages feed

wikimusic-ssr (empty) → 0.6.0.0

raw patch · 36 files changed

+3301/−0 lines, 36 filesdep +HTTPdep +aesondep +asyncsetup-changed

Dependencies added: HTTP, aeson, async, base, base16-bytestring, base64-bytestring, blaze-html, bytestring, containers, directory, filepath, free-alacarte, http-client, http-client-tls, keuringsdienst, keys, mtl, neat-interpolation, optics, optparse-applicative, relude, servant, servant-auth-server, servant-blaze, servant-client, servant-multipart, servant-server, text, time, tomland, uuid, wai, wai-cors, wai-extra, warp, wikimusic-api-spec, wikimusic-model-hs, wikimusic-ssr

Files

+ CHANGELOG.org view
+ README.org view
@@ -0,0 +1,26 @@+#+title: WikiMusic  SSR+#+options: toc:nil++Server side rendered (SSR) frontend for WikiMusic++/WikiMusic/++#+begin_html+<div>+<img src="https://img.shields.io/badge/Haskell-5D4F85?logo=haskell&logoColor=fff&style=plastic" alt="Haskell"/>+<img src="https://img.shields.io/badge/GNU%20Emacs-7F5AB6?logo=gnuemacs&logoColor=fff&style=plastic" alt="GNU Emacs"/>+<img src="https://img.shields.io/badge/NixOS-5277C3?logo=nixos&logoColor=fff&style=plastic" alt="NixOS"/>+</div>+#+end_html+++WikiMusic as a software means an ingenious combination of a server-side-rendered frontend, a powerful backend REST API, a database, and a user-interface to create a Content Management System (CMS) and a Gallery for music of all kinds, with educational intents.++This is 100% free software, licensed under the GNU General Public License v3 or later.+[[https://www.gnu.org/licenses/gpl-3.0.en.html][Refer to the full license, on GNU's website]]++The WikiMusic project is an invite-only community, with the goal of knowledge sharing, and not profit driven.++[[https://www.buymeacoffee.com/jjbigorra][Please donate by clicking here]]. This helps us keep the underlying cloud infrastructure and Joe's work hours going strong.++In this Git repository you will find the source code behind WikiMusic's frontend.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,7 @@+module Main (main) where++import Relude+import WikiMusic.SSR.Boot qualified++main :: (MonadIO m) => m ()+main = liftIO WikiMusic.SSR.Boot.boot
+ src/WikiMusic/SSR/Backend/Rest.hs view
@@ -0,0 +1,528 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoFieldSelectors #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.Backend.Rest () where++import Data.Text (pack)+import Data.UUID (UUID)+import Free.AlaCarte+import Optics+import Relude+import Servant+import Servant.Client+import WikiMusic.Interaction.Model.Artist+import WikiMusic.Interaction.Model.Auth+import WikiMusic.Interaction.Model.Genre+import WikiMusic.Interaction.Model.Song+import WikiMusic.Interaction.Model.User+import WikiMusic.Model.Auth+import WikiMusic.Model.Other+import WikiMusic.SSR.Free.Backend+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env+import WikiMusic.Servant.ApiSpec++instance Exec Backend where+  -- artists+  execAlgebra (GetArtists env authToken limit offset sortOrder include next) =+    next =<< getArtists' env authToken limit offset sortOrder include+  execAlgebra (SearchArtists env authToken search limit offset sortOrder include next) =+    next =<< searchArtists' env authToken search limit offset sortOrder include+  execAlgebra (GetArtist env authToken identifier include next) =+    next =<< getArtist' env authToken identifier include+  execAlgebra (CreateArtist env authToken r next) =+    next =<< createArtist' env authToken r+  execAlgebra (CreateArtistComment env authToken r next) =+    next =<< createArtistComment' env authToken r+  execAlgebra (UpsertArtistOpinion env authToken r next) =+    next =<< upsertArtistOpinion' env authToken r+  execAlgebra (CreateArtistArtwork env authToken r next) =+    next =<< createArtistArtwork' env authToken r+  execAlgebra (DeleteArtist env authToken identifier next) =+    next =<< deleteArtist' env authToken identifier+  execAlgebra (DeleteArtistComment env authToken identifier next) =+    next =<< deleteArtistComment' env authToken identifier+  execAlgebra (DeleteArtistOpinion env authToken identifier next) =+    next =<< deleteArtistOpinion' env authToken identifier+  execAlgebra (DeleteArtistArtwork env authToken identifier next) =+    next =<< deleteArtistArtwork' env authToken identifier+  execAlgebra (UpdateArtistArtworkOrder env authToken r next) =+    next =<< updateArtistArtworkOrder' env authToken r+  execAlgebra (EditArtist env authToken r next) =+    next =<< editArtist' env authToken r+  -- genres+  execAlgebra (GetGenres env authToken limit offset sortOrder include next) =+    next =<< getGenres' env authToken limit offset sortOrder include+  execAlgebra (SearchGenres env authToken search limit offset sortOrder include next) =+    next =<< searchGenres' env authToken search limit offset sortOrder include+  execAlgebra (GetGenre env authToken identifier include next) =+    next =<< getGenre' env authToken identifier include+  execAlgebra (CreateGenre env authToken r next) =+    next =<< createGenre' env authToken r+  execAlgebra (CreateGenreComment env authToken r next) =+    next =<< createGenreComment' env authToken r+  execAlgebra (UpsertGenreOpinion env authToken r next) =+    next =<< upsertGenreOpinion' env authToken r+  execAlgebra (CreateGenreArtwork env authToken r next) =+    next =<< createGenreArtwork' env authToken r+  execAlgebra (DeleteGenre env authToken identifier next) =+    next =<< deleteGenre' env authToken identifier+  execAlgebra (DeleteGenreComment env authToken identifier next) =+    next =<< deleteGenreComment' env authToken identifier+  execAlgebra (DeleteGenreOpinion env authToken identifier next) =+    next =<< deleteGenreOpinion' env authToken identifier+  execAlgebra (DeleteGenreArtwork env authToken identifier next) =+    next =<< deleteGenreArtwork' env authToken identifier+  execAlgebra (UpdateGenreArtworkOrder env authToken r next) =+    next =<< updateGenreArtworkOrder' env authToken r+  execAlgebra (EditGenre env authToken r next) =+    next =<< editGenre' env authToken r+  -- songs+  execAlgebra (GetSongs env authToken limit offset sortOrder include next) =+    next =<< getSongs' env authToken limit offset sortOrder include+  execAlgebra (SearchSongs env authToken search limit offset sortOrder include next) =+    next =<< searchSongs' env authToken search limit offset sortOrder include+  execAlgebra (GetSong env authToken identifier include next) =+    next =<< getSong' env authToken identifier include+  execAlgebra (CreateSong env authToken r next) =+    next =<< createSong' env authToken r+  execAlgebra (CreateSongComment env authToken r next) =+    next =<< createSongComment' env authToken r+  execAlgebra (UpsertSongOpinion env authToken r next) =+    next =<< upsertSongOpinion' env authToken r+  execAlgebra (CreateSongArtwork env authToken r next) =+    next =<< createSongArtwork' env authToken r+  execAlgebra (CreateArtistOfSong env authToken r next) =+    next =<< createArtistOfSong' env authToken r+  execAlgebra (DeleteArtistOfSong env authToken r next) =+    next =<< deleteArtistOfSong' env authToken r+  execAlgebra (DeleteSong env authToken identifier next) =+    next =<< deleteSong' env authToken identifier+  execAlgebra (DeleteSongComment env authToken identifier next) =+    next =<< deleteSongComment' env authToken identifier+  execAlgebra (DeleteSongOpinion env authToken identifier next) =+    next =<< deleteSongOpinion' env authToken identifier+  execAlgebra (DeleteSongArtwork env authToken identifier next) =+    next =<< deleteSongArtwork' env authToken identifier+  execAlgebra (UpdateSongArtworkOrder env authToken r next) =+    next =<< updateSongArtworkOrder' env authToken r+  execAlgebra (EditSong env authToken r next) =+    next =<< editSong' env authToken r+  execAlgebra (CreateSongContents env authToken r next) =+    next =<< createSongContents' env authToken r+  execAlgebra (DeleteSongContents env authToken identifier next) =+    next =<< deleteSongContents' env authToken identifier+  execAlgebra (EditSongContents env authToken r next) =+    next =<< editSongContents' env authToken r+  -- auth+  execAlgebra (Me env authToken next) =+    next =<< me' env authToken+  execAlgebra (UserInvite env authToken r next) =+    next =<< userInvite' env authToken r+  execAlgebra (UserDelete env authToken r next) =+    next =<< userDelete' env authToken r+  -- more+  execAlgebra (Login env loginRequest next) =+    next =<< login' env loginRequest+  execAlgebra (ResetPassword env r next) =+    next =<< resetPassword' env r+  execAlgebra (ResetPasswordDo env r next) =+    next =<< resetPasswordDo' env r+  execAlgebra (SystemInformation env next) =+    next =<< systemInformation' env++-- artists++getArtists' :: (MonadIO m) => Env -> AuthToken -> Limit -> Offset -> SortOrder -> Include -> m (Either Text GetArtistsQueryResponse)+getArtists' env authToken (Limit limit) (Offset offset) sortOrder include = do+  doRest env+    $ getArtistsHTTP (Just $ authToken ^. #value) (Just limit) (Just offset) (Just $ sortOrder ^. #value) (Just $ include ^. #value)++searchArtists' :: (MonadIO m) => Env -> AuthToken -> Text -> Limit -> Offset -> SortOrder -> Include -> m (Either Text GetArtistsQueryResponse)+searchArtists' env authToken search (Limit limit) (Offset offset) sortOrder include = do+  doRest env+    $ searchArtistsHTTP (Just $ authToken ^. #value) search (Just limit) (Just offset) (Just $ sortOrder ^. #value) (Just $ include ^. #value)++getArtist' :: (MonadIO m) => Env -> AuthToken -> UUID -> Include -> m (Either Text GetArtistsQueryResponse)+getArtist' env authToken identifier include = do+  doRest env+    $ getArtistHTTP (Just $ authToken ^. #value) identifier Nothing (Just $ include ^. #value)++createArtist' :: (MonadIO m) => Env -> AuthToken -> InsertArtistsRequest -> m (Either Text InsertArtistsCommandResponse)+createArtist' env authToken r = do+  doRest env+    $ createArtistHTTP (Just $ authToken ^. #value) r++createArtistComment' :: (MonadIO m) => Env -> AuthToken -> InsertArtistCommentsRequest -> m (Either Text InsertArtistCommentsCommandResponse)+createArtistComment' env authToken r = do+  doRest env+    $ createArtistCommentHTTP (Just $ authToken ^. #value) r++upsertArtistOpinion' :: (MonadIO m) => Env -> AuthToken -> UpsertArtistOpinionsRequest -> m (Either Text UpsertArtistOpinionsCommandResponse)+upsertArtistOpinion' env authToken r = do+  doRest env+    $ upsertArtistOpinionHTTP (Just $ authToken ^. #value) r++createArtistArtwork' :: (MonadIO m) => Env -> AuthToken -> InsertArtistArtworksRequest -> m (Either Text InsertArtistArtworksCommandResponse)+createArtistArtwork' env authToken r = do+  doRest env+    $ createArtistArtworkHTTP (Just $ authToken ^. #value) r++deleteArtist' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteArtist' env authToken identifier = do+  doRest env+    $ deleteArtistHTTP (Just $ authToken ^. #value) identifier++deleteArtistComment' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteArtistComment' env authToken identifier = do+  doRest env+    $ deleteArtistCommentHTTP (Just $ authToken ^. #value) identifier++deleteArtistOpinion' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteArtistOpinion' env authToken identifier = do+  doRest env+    $ deleteArtistOpinionHTTP (Just $ authToken ^. #value) identifier++deleteArtistArtwork' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteArtistArtwork' env authToken identifier = do+  doRest env+    $ deleteArtistArtworkHTTP (Just $ authToken ^. #value) identifier++updateArtistArtworkOrder' :: (MonadIO m) => Env -> AuthToken -> ArtistArtworkOrderUpdateRequest -> m (Either Text ())+updateArtistArtworkOrder' env authToken r = do+  doRest env+    $ updateArtistArtworkOrderHTTP (Just $ authToken ^. #value) r++editArtist' :: (MonadIO m) => Env -> AuthToken -> ArtistDeltaRequest -> m (Either Text ())+editArtist' env authToken r = do+  doRest env+    $ editArtistHTTP (Just $ authToken ^. #value) r++-- genres++getGenres' :: (MonadIO m) => Env -> AuthToken -> Limit -> Offset -> SortOrder -> Include -> m (Either Text GetGenresQueryResponse)+getGenres' env authToken (Limit limit) (Offset offset) sortOrder include = do+  doRest env+    $ getGenresHTTP (Just $ authToken ^. #value) (Just limit) (Just offset) (Just $ sortOrder ^. #value) (Just $ include ^. #value)++searchGenres' :: (MonadIO m) => Env -> AuthToken -> Text -> Limit -> Offset -> SortOrder -> Include -> m (Either Text GetGenresQueryResponse)+searchGenres' env authToken search (Limit limit) (Offset offset) sortOrder include = do+  doRest env+    $ searchGenresHTTP (Just $ authToken ^. #value) search (Just limit) (Just offset) (Just $ sortOrder ^. #value) (Just $ include ^. #value)++getGenre' :: (MonadIO m) => Env -> AuthToken -> UUID -> Include -> m (Either Text GetGenresQueryResponse)+getGenre' env authToken identifier include = do+  doRest env+    $ getGenreHTTP (Just $ authToken ^. #value) identifier Nothing (Just $ include ^. #value)++createGenre' :: (MonadIO m) => Env -> AuthToken -> InsertGenresRequest -> m (Either Text InsertGenresCommandResponse)+createGenre' env authToken r = do+  doRest env+    $ createGenreHTTP (Just $ authToken ^. #value) r++createGenreComment' :: (MonadIO m) => Env -> AuthToken -> InsertGenreCommentsRequest -> m (Either Text InsertGenreCommentsCommandResponse)+createGenreComment' env authToken r = do+  doRest env+    $ createGenreCommentHTTP (Just $ authToken ^. #value) r++upsertGenreOpinion' :: (MonadIO m) => Env -> AuthToken -> UpsertGenreOpinionsRequest -> m (Either Text UpsertGenreOpinionsCommandResponse)+upsertGenreOpinion' env authToken r = do+  doRest env+    $ upsertGenreOpinionHTTP (Just $ authToken ^. #value) r++createGenreArtwork' :: (MonadIO m) => Env -> AuthToken -> InsertGenreArtworksRequest -> m (Either Text InsertGenreArtworksCommandResponse)+createGenreArtwork' env authToken r = do+  doRest env+    $ createGenreArtworkHTTP (Just $ authToken ^. #value) r++deleteGenre' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteGenre' env authToken identifier = do+  doRest env+    $ deleteGenreHTTP (Just $ authToken ^. #value) identifier++deleteGenreComment' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteGenreComment' env authToken identifier = do+  doRest env+    $ deleteGenreCommentHTTP (Just $ authToken ^. #value) identifier++deleteGenreOpinion' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteGenreOpinion' env authToken identifier = do+  doRest env+    $ deleteGenreOpinionHTTP (Just $ authToken ^. #value) identifier++deleteGenreArtwork' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteGenreArtwork' env authToken identifier = do+  doRest env+    $ deleteGenreArtworkHTTP (Just $ authToken ^. #value) identifier++updateGenreArtworkOrder' :: (MonadIO m) => Env -> AuthToken -> GenreArtworkOrderUpdateRequest -> m (Either Text ())+updateGenreArtworkOrder' env authToken r = do+  doRest env+    $ updateGenreArtworkOrderHTTP (Just $ authToken ^. #value) r++editGenre' :: (MonadIO m) => Env -> AuthToken -> GenreDeltaRequest -> m (Either Text ())+editGenre' env authToken r = do+  doRest env+    $ editGenreHTTP (Just $ authToken ^. #value) r++-- songs++getSongs' :: (MonadIO m) => Env -> AuthToken -> Limit -> Offset -> SortOrder -> Include -> m (Either Text GetSongsQueryResponse)+getSongs' env authToken (Limit limit) (Offset offset) sortOrder include = do+  doRest env+    $ getSongsHTTP (Just $ authToken ^. #value) (Just limit) (Just offset) (Just $ sortOrder ^. #value) (Just $ include ^. #value)++searchSongs' :: (MonadIO m) => Env -> AuthToken -> Text -> Limit -> Offset -> SortOrder -> Include -> m (Either Text GetSongsQueryResponse)+searchSongs' env authToken search (Limit limit) (Offset offset) sortOrder include = do+  doRest env+    $ searchSongsHTTP (Just $ authToken ^. #value) search (Just limit) (Just offset) (Just $ sortOrder ^. #value) (Just $ include ^. #value)++getSong' :: (MonadIO m) => Env -> AuthToken -> UUID -> Include -> m (Either Text GetSongsQueryResponse)+getSong' env authToken identifier include = do+  doRest env+    $ getSongHTTP (Just $ authToken ^. #value) identifier Nothing (Just $ include ^. #value)++createSong' :: (MonadIO m) => Env -> AuthToken -> InsertSongsRequest -> m (Either Text InsertSongsCommandResponse)+createSong' env authToken r = do+  doRest env+    $ createSongHTTP (Just $ authToken ^. #value) r++createSongComment' :: (MonadIO m) => Env -> AuthToken -> InsertSongCommentsRequest -> m (Either Text InsertSongCommentsCommandResponse)+createSongComment' env authToken r = do+  doRest env+    $ createSongCommentHTTP (Just $ authToken ^. #value) r++upsertSongOpinion' :: (MonadIO m) => Env -> AuthToken -> UpsertSongOpinionsRequest -> m (Either Text UpsertSongOpinionsCommandResponse)+upsertSongOpinion' env authToken r = do+  doRest env+    $ upsertSongOpinionHTTP (Just $ authToken ^. #value) r++createSongArtwork' :: (MonadIO m) => Env -> AuthToken -> InsertSongArtworksRequest -> m (Either Text InsertSongArtworksCommandResponse)+createSongArtwork' env authToken r = do+  doRest env+    $ createSongArtworkHTTP (Just $ authToken ^. #value) r++deleteSong' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteSong' env authToken identifier = do+  doRest env+    $ deleteSongHTTP (Just $ authToken ^. #value) identifier++deleteSongComment' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteSongComment' env authToken identifier = do+  doRest env+    $ deleteSongCommentHTTP (Just $ authToken ^. #value) identifier++deleteSongOpinion' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteSongOpinion' env authToken identifier = do+  doRest env+    $ deleteSongOpinionHTTP (Just $ authToken ^. #value) identifier++deleteSongArtwork' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteSongArtwork' env authToken identifier = do+  doRest env+    $ deleteSongArtworkHTTP (Just $ authToken ^. #value) identifier++updateSongArtworkOrder' :: (MonadIO m) => Env -> AuthToken -> SongArtworkOrderUpdateRequest -> m (Either Text ())+updateSongArtworkOrder' env authToken r = do+  doRest env+    $ updateSongArtworkOrderHTTP (Just $ authToken ^. #value) r++editSong' :: (MonadIO m) => Env -> AuthToken -> SongDeltaRequest -> m (Either Text ())+editSong' env authToken r = do+  doRest env+    $ editSongHTTP (Just $ authToken ^. #value) r++createArtistOfSong' :: (MonadIO m) => Env -> AuthToken -> InsertArtistsOfSongsRequest -> m (Either Text InsertArtistsOfSongCommandResponse)+createArtistOfSong' env authToken r = do+  doRest env+    $ createArtistOfSongHTTP (Just $ authToken ^. #value) r++deleteArtistOfSong' :: (MonadIO m) => Env -> AuthToken -> InsertArtistsOfSongsRequest -> m (Either Text ())+deleteArtistOfSong' env authToken r = do+  doRest env+    $ deleteArtistOfSongHTTP (Just $ authToken ^. #value) r++createSongContents' :: (MonadIO m) => Env -> AuthToken -> InsertSongContentsRequest -> m (Either Text InsertSongContentsCommandResponse)+createSongContents' env authToken r = do+  doRest env+    $ createSongContentsHTTP (Just $ authToken ^. #value) r++deleteSongContents' :: (MonadIO m) => Env -> AuthToken -> UUID -> m (Either Text ())+deleteSongContents' env authToken identifier = do+  doRest env+    $ deleteSongContentsHTTP (Just $ authToken ^. #value) identifier++editSongContents' :: (MonadIO m) => Env -> AuthToken -> SongContentDeltaRequest -> m (Either Text ())+editSongContents' env authToken r = do+  doRest env+    $ editSongContentsHTTP (Just $ authToken ^. #value) r++-- auth+me' :: (MonadIO m) => Env -> AuthToken -> m (Either Text GetMeQueryResponse)+me' env authToken = doRest env $ meHTTP (Just $ authToken ^. #value)++userInvite' :: (MonadIO m) => Env -> AuthToken -> InviteUsersRequest -> m (Either Text MakeResetPasswordLinkResponse)+userInvite' env authToken r = doRest env $ userInviteHTTP (Just $ authToken ^. #value) r++userDelete' :: (MonadIO m) => Env -> AuthToken -> DeleteUsersRequest -> m (Either Text ())+userDelete' env authToken r = doRest env $ userDeleteHTTP (Just $ authToken ^. #value) r++-- more++login' :: (MonadIO m) => Env -> LoginRequest -> m (Either Text Text)+login' env loginRequest = do+  eitherResponse <- doRest env $ loginHTTP loginRequest+  let maybeParsedHeaders = second (nonEmpty . map snd . filter (\(name, _) -> name == "x-wikimusic-auth") . getHeaders) eitherResponse+  case maybeParsedHeaders of+    Left e -> pure . Left $ e+    Right Nothing -> pure . Left $ "No x-wikimusic-auth header was found!"+    Right (Just h) -> pure . Right . decodeUtf8 . head $ h++resetPassword' :: (MonadIO m) => Env -> Text -> m (Either Text MakeResetPasswordLinkResponse)+resetPassword' env r = doRest env $ resetPasswordHTTP r++resetPasswordDo' :: (MonadIO m) => Env -> DoPasswordResetRequest -> m (Either Text ())+resetPasswordDo' env r = doRest env $ resetPasswordDoHTTP r++systemInformation' :: (MonadIO m) => Env -> m (Either Text SystemInformationResponse)+systemInformation' env = doRest env systemInformationHTTP++--+--+--++doRest :: (MonadIO m) => Env -> ClientM r -> m (Either Text r)+doRest env restCall = do+  eff <- liftIO $ runClientM restCall (env ^. #clientEnv)+  pure $ first (pack . Relude.show) eff++backendAPI :: Proxy BackendAPI+backendAPI = Proxy++type BackendAPI =+  WikiMusicPrivateArtistsAPI+    :<|> WikiMusicPrivateGenresAPI+    :<|> WikiMusicPrivateSongsAPI+    :<|> WikiMusicPrivateAuthAPI+    :<|> WikiMusicPublicAPI++--+getArtistsHTTP :: Maybe Text -> Maybe Int -> Maybe Int -> Maybe Text -> Maybe Text -> ClientM GetArtistsQueryResponse+searchArtistsHTTP :: Maybe Text -> Text -> Maybe Int -> Maybe Int -> Maybe Text -> Maybe Text -> ClientM GetArtistsQueryResponse+getArtistHTTP :: Maybe Text -> UUID -> Maybe Text -> Maybe Text -> ClientM GetArtistsQueryResponse+createArtistHTTP :: Maybe Text -> InsertArtistsRequest -> ClientM InsertArtistsCommandResponse+createArtistCommentHTTP :: Maybe Text -> InsertArtistCommentsRequest -> ClientM InsertArtistCommentsCommandResponse+upsertArtistOpinionHTTP :: Maybe Text -> UpsertArtistOpinionsRequest -> ClientM UpsertArtistOpinionsCommandResponse+createArtistArtworkHTTP :: Maybe Text -> InsertArtistArtworksRequest -> ClientM InsertArtistArtworksCommandResponse+deleteArtistHTTP :: Maybe Text -> UUID -> ClientM ()+deleteArtistCommentHTTP :: Maybe Text -> UUID -> ClientM ()+deleteArtistOpinionHTTP :: Maybe Text -> UUID -> ClientM ()+deleteArtistArtworkHTTP :: Maybe Text -> UUID -> ClientM ()+updateArtistArtworkOrderHTTP :: Maybe Text -> ArtistArtworkOrderUpdateRequest -> ClientM ()+editArtistHTTP :: Maybe Text -> ArtistDeltaRequest -> ClientM ()+--+getGenresHTTP :: Maybe Text -> Maybe Int -> Maybe Int -> Maybe Text -> Maybe Text -> ClientM GetGenresQueryResponse+searchGenresHTTP :: Maybe Text -> Text -> Maybe Int -> Maybe Int -> Maybe Text -> Maybe Text -> ClientM GetGenresQueryResponse+getGenreHTTP :: Maybe Text -> UUID -> Maybe Text -> Maybe Text -> ClientM GetGenresQueryResponse+createGenreHTTP :: Maybe Text -> InsertGenresRequest -> ClientM InsertGenresCommandResponse+createGenreCommentHTTP :: Maybe Text -> InsertGenreCommentsRequest -> ClientM InsertGenreCommentsCommandResponse+upsertGenreOpinionHTTP :: Maybe Text -> UpsertGenreOpinionsRequest -> ClientM UpsertGenreOpinionsCommandResponse+createGenreArtworkHTTP :: Maybe Text -> InsertGenreArtworksRequest -> ClientM InsertGenreArtworksCommandResponse+deleteGenreHTTP :: Maybe Text -> UUID -> ClientM ()+deleteGenreCommentHTTP :: Maybe Text -> UUID -> ClientM ()+deleteGenreOpinionHTTP :: Maybe Text -> UUID -> ClientM ()+deleteGenreArtworkHTTP :: Maybe Text -> UUID -> ClientM ()+updateGenreArtworkOrderHTTP :: Maybe Text -> GenreArtworkOrderUpdateRequest -> ClientM ()+editGenreHTTP :: Maybe Text -> GenreDeltaRequest -> ClientM ()+--+getSongsHTTP :: Maybe Text -> Maybe Int -> Maybe Int -> Maybe Text -> Maybe Text -> ClientM GetSongsQueryResponse+searchSongsHTTP :: Maybe Text -> Text -> Maybe Int -> Maybe Int -> Maybe Text -> Maybe Text -> ClientM GetSongsQueryResponse+getSongHTTP :: Maybe Text -> UUID -> Maybe Text -> Maybe Text -> ClientM GetSongsQueryResponse+createSongHTTP :: Maybe Text -> InsertSongsRequest -> ClientM InsertSongsCommandResponse+createSongCommentHTTP :: Maybe Text -> InsertSongCommentsRequest -> ClientM InsertSongCommentsCommandResponse+upsertSongOpinionHTTP :: Maybe Text -> UpsertSongOpinionsRequest -> ClientM UpsertSongOpinionsCommandResponse+createSongArtworkHTTP :: Maybe Text -> InsertSongArtworksRequest -> ClientM InsertSongArtworksCommandResponse+createArtistOfSongHTTP :: Maybe Text -> InsertArtistsOfSongsRequest -> ClientM InsertArtistsOfSongCommandResponse+deleteArtistOfSongHTTP :: Maybe Text -> InsertArtistsOfSongsRequest -> ClientM ()+deleteSongHTTP :: Maybe Text -> UUID -> ClientM ()+deleteSongCommentHTTP :: Maybe Text -> UUID -> ClientM ()+deleteSongOpinionHTTP :: Maybe Text -> UUID -> ClientM ()+deleteSongArtworkHTTP :: Maybe Text -> UUID -> ClientM ()+updateSongArtworkOrderHTTP :: Maybe Text -> SongArtworkOrderUpdateRequest -> ClientM ()+editSongHTTP :: Maybe Text -> SongDeltaRequest -> ClientM ()+createSongContentsHTTP :: Maybe Text -> InsertSongContentsRequest -> ClientM InsertSongContentsCommandResponse+deleteSongContentsHTTP :: Maybe Text -> UUID -> ClientM ()+editSongContentsHTTP :: Maybe Text -> SongContentDeltaRequest -> ClientM ()+--+meHTTP :: Maybe Text -> ClientM GetMeQueryResponse+userInviteHTTP :: Maybe Text -> InviteUsersRequest -> ClientM MakeResetPasswordLinkResponse+userDeleteHTTP :: Maybe Text -> DeleteUsersRequest -> ClientM ()+--+loginHTTP ::+  LoginRequest ->+  ClientM+    ( Headers+        '[Header "x-wikimusic-auth" Text]+        NoContent+    )+resetPasswordHTTP :: Text -> ClientM MakeResetPasswordLinkResponse+resetPasswordDoHTTP :: DoPasswordResetRequest -> ClientM ()+systemInformationHTTP :: ClientM SystemInformationResponse+-- artists+( getArtistsHTTP+    :<|> searchArtistsHTTP+    :<|> getArtistHTTP+    :<|> createArtistHTTP+    :<|> createArtistCommentHTTP+    :<|> upsertArtistOpinionHTTP+    :<|> createArtistArtworkHTTP+    :<|> deleteArtistHTTP+    :<|> deleteArtistCommentHTTP+    :<|> deleteArtistOpinionHTTP+    :<|> deleteArtistArtworkHTTP+    :<|> updateArtistArtworkOrderHTTP+    :<|> editArtistHTTP+  )+  -- genres+  :<|> ( getGenresHTTP+           :<|> searchGenresHTTP+           :<|> getGenreHTTP+           :<|> createGenreHTTP+           :<|> createGenreCommentHTTP+           :<|> upsertGenreOpinionHTTP+           :<|> createGenreArtworkHTTP+           :<|> deleteGenreHTTP+           :<|> deleteGenreCommentHTTP+           :<|> deleteGenreOpinionHTTP+           :<|> deleteGenreArtworkHTTP+           :<|> updateGenreArtworkOrderHTTP+           :<|> editGenreHTTP+         )+  -- songs+  :<|> ( getSongsHTTP+           :<|> searchSongsHTTP+           :<|> getSongHTTP+           :<|> createSongHTTP+           :<|> createSongCommentHTTP+           :<|> upsertSongOpinionHTTP+           :<|> createSongArtworkHTTP+           :<|> createArtistOfSongHTTP+           :<|> deleteArtistOfSongHTTP+           :<|> deleteSongHTTP+           :<|> deleteSongCommentHTTP+           :<|> deleteSongOpinionHTTP+           :<|> deleteSongArtworkHTTP+           :<|> updateSongArtworkOrderHTTP+           :<|> editSongHTTP+           :<|> createSongContentsHTTP+           :<|> deleteSongContentsHTTP+           :<|> editSongContentsHTTP+         )+  -- auth+  :<|> (meHTTP :<|> userInviteHTTP :<|> userDeleteHTTP)+  -- public+  :<|> (loginHTTP :<|> resetPasswordHTTP :<|> resetPasswordDoHTTP :<|> systemInformationHTTP) =+    client backendAPI
+ src/WikiMusic/SSR/Boot.hs view
@@ -0,0 +1,33 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoFieldSelectors #-}++module WikiMusic.SSR.Boot (boot) where++import Control.Monad+import Data.ByteString.Lazy qualified as BL+import Data.Text (pack)+import Network.Wai.Handler.Warp+import Optics+import Relude+import WikiMusic.SSR.Config+import WikiMusic.SSR.Model.Config+import WikiMusic.SSR.Servant.ApiSetup++boot :: (MonadIO m) => m ()+boot = do+  args <- liftIO getArgs+  maybeCfg <- readConfig (cfg args)+  liftIO $ either crashWithBadConfig startWikiMusicSSR maybeCfg+  where+    crashWithBadConfig e = error ("Bad config could not be parsed! " <> show e)+    cfg args = case nonEmpty args of+      Just (x :| []) -> pack x+      _ -> "resources/config/run-local.toml"++startWikiMusicSSR :: (MonadIO m) => AppConfig -> m ()+startWikiMusicSSR cfg = do+  liftIO . BL.putStr $ "Starting WikiMusic SSR ..."+  liftIO $ runSettings apiSettings =<< mkApp cfg+  where+    apiSettings = setPort (cfg ^. #servant % #port) defaultSettings
+ src/WikiMusic/SSR/Clock/LiveClock.hs view
@@ -0,0 +1,20 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.Clock.LiveClock () where++import Data.Text qualified as T+import Data.Time+import Free.AlaCarte+import Relude+import WikiMusic.SSR.Free.Clock++instance Exec Clock where+  execAlgebra (TimeElapsedUntilNow fromTime f) = do+    diffWithNow fromTime >>= f+  execAlgebra (Now f) = do+    getCurrentTime >>= f++diffWithNow :: (MonadIO m) => UTCTime -> m Text+diffWithNow fromTime = do+  now' <- liftIO getCurrentTime+  pure $ T.pack . show $ diffUTCTime now' fromTime
+ src/WikiMusic/SSR/Config.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoFieldSelectors #-}++module WikiMusic.SSR.Config (readConfig) where++import Data.Text (unpack)+import Relude+import Toml+import WikiMusic.SSR.Model.Config++readConfig :: (MonadIO m) => Text -> m (Either Text AppConfig)+readConfig filePath = do+  parseResult <- liftIO $ decodeFileEither appConfigCodec (unpack filePath)+  case parseResult of+    Left e -> pure . Left $ prettyTomlDecodeErrors e+    Right r -> pure . Right $ r
+ src/WikiMusic/SSR/Console/Logger.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoFieldSelectors #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.Console.Logger () where++import Data.ByteString.Lazy qualified as BL+import Data.Text qualified as T+import Data.Time+import Free.AlaCarte+import Relude+import WikiMusic.SSR.Free.Logger++instance Exec Logger where+  execAlgebra (LogInfo msg next) = do+    now <- iso8601+    _ <- textToStdout (logExpr now "INFO" msg)+    next+  execAlgebra (LogError msg next) = do+    now <- iso8601+    _ <- textToStderr (logExpr now "ERROR" msg)+    next+  execAlgebra (LogDebug msg next) = do+    now <- iso8601+    _ <- textToStdout (logExpr now "DEBUG" msg)+    next++textToStdout :: (MonadIO m) => Text -> m ()+textToStdout = liftIO . BL.hPutStr stdout . BL.fromStrict . encodeUtf8 . liner++textToStderr :: (MonadIO m) => Text -> m ()+textToStderr = liftIO . BL.hPutStr stderr . BL.fromStrict . encodeUtf8 . liner++liner :: Text -> Text+liner = (<> "\n")++-- Construct format string according to <http://en.wikipedia.org/wiki/ISO_8601 ISO-8601>.+iso8601 :: (MonadIO m) => m Text+iso8601 = do+  n <- liftIO getCurrentTime+  let n' = T.pack $ formatTime defaultTimeLocale (T.unpack "%Y-%m-%dT%H:%M:%SZ") n+  pure n'++logExpr :: (Semigroup a, IsString a) => a -> a -> a -> a+logExpr now lev msg = "[" <> now <> "][" <> lev <> "] " <> msg
+ src/WikiMusic/SSR/Free/Backend.hs view
@@ -0,0 +1,288 @@+module WikiMusic.SSR.Free.Backend+  ( getArtists,+    getArtist,+    Backend (..),+    login,+    getGenres,+    getGenre,+    getSongs,+    getSong,+    searchArtists,+    searchGenres,+    searchSongs,+    createArtist,+    createGenre,+    createSong,+    createSongComment,+    upsertSongOpinion,+    createSongArtwork,+    deleteSong,+    deleteSongComment,+    deleteSongOpinion,+    deleteSongArtwork,+    updateSongArtworkOrder,+    editSong,+    editGenre,+    updateGenreArtworkOrder,+    deleteGenreArtwork,+    deleteGenreOpinion,+    deleteGenreComment,+    deleteGenre,+    createGenreArtwork,+    upsertGenreOpinion,+    createGenreComment,+    createArtistComment,+    upsertArtistOpinion,+    createArtistArtwork,+    deleteArtist,+    deleteArtistComment,+    deleteArtistOpinion,+    editArtist,+    updateArtistArtworkOrder,+    deleteArtistArtwork,+    createArtistOfSong,+    deleteArtistOfSong,+    createSongContents,+    editSongContents,+    deleteSongContents,+    systemInformation,+    resetPassword,+    resetPasswordDo,+    userInvite,+    userDelete,+    me,+  )+where++import Data.UUID (UUID)+import Free.AlaCarte+import Relude+import WikiMusic.Interaction.Model.Artist+import WikiMusic.Interaction.Model.Auth+import WikiMusic.Interaction.Model.Genre+import WikiMusic.Interaction.Model.Song+import WikiMusic.Interaction.Model.User+import WikiMusic.Model.Auth+import WikiMusic.Model.Other+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env++type Backend :: Type -> Type+data Backend a+  = -- artists+    GetArtists Env AuthToken Limit Offset SortOrder Include (Either Text GetArtistsQueryResponse -> a)+  | SearchArtists Env AuthToken Text Limit Offset SortOrder Include (Either Text GetArtistsQueryResponse -> a)+  | GetArtist Env AuthToken UUID Include (Either Text GetArtistsQueryResponse -> a)+  | CreateArtist Env AuthToken InsertArtistsRequest (Either Text InsertArtistsCommandResponse -> a)+  | CreateArtistComment Env AuthToken InsertArtistCommentsRequest (Either Text InsertArtistCommentsCommandResponse -> a)+  | UpsertArtistOpinion Env AuthToken UpsertArtistOpinionsRequest (Either Text UpsertArtistOpinionsCommandResponse -> a)+  | CreateArtistArtwork Env AuthToken InsertArtistArtworksRequest (Either Text InsertArtistArtworksCommandResponse -> a)+  | DeleteArtist Env AuthToken UUID (Either Text () -> a)+  | DeleteArtistComment Env AuthToken UUID (Either Text () -> a)+  | DeleteArtistOpinion Env AuthToken UUID (Either Text () -> a)+  | DeleteArtistArtwork Env AuthToken UUID (Either Text () -> a)+  | UpdateArtistArtworkOrder Env AuthToken ArtistArtworkOrderUpdateRequest (Either Text () -> a)+  | EditArtist Env AuthToken ArtistDeltaRequest (Either Text () -> a)+  | -- genres+    GetGenres Env AuthToken Limit Offset SortOrder Include (Either Text GetGenresQueryResponse -> a)+  | SearchGenres Env AuthToken Text Limit Offset SortOrder Include (Either Text GetGenresQueryResponse -> a)+  | GetGenre Env AuthToken UUID Include (Either Text GetGenresQueryResponse -> a)+  | CreateGenre Env AuthToken InsertGenresRequest (Either Text InsertGenresCommandResponse -> a)+  | CreateGenreComment Env AuthToken InsertGenreCommentsRequest (Either Text InsertGenreCommentsCommandResponse -> a)+  | UpsertGenreOpinion Env AuthToken UpsertGenreOpinionsRequest (Either Text UpsertGenreOpinionsCommandResponse -> a)+  | CreateGenreArtwork Env AuthToken InsertGenreArtworksRequest (Either Text InsertGenreArtworksCommandResponse -> a)+  | DeleteGenre Env AuthToken UUID (Either Text () -> a)+  | DeleteGenreComment Env AuthToken UUID (Either Text () -> a)+  | DeleteGenreOpinion Env AuthToken UUID (Either Text () -> a)+  | DeleteGenreArtwork Env AuthToken UUID (Either Text () -> a)+  | UpdateGenreArtworkOrder Env AuthToken GenreArtworkOrderUpdateRequest (Either Text () -> a)+  | EditGenre Env AuthToken GenreDeltaRequest (Either Text () -> a)+  | -- songs+    GetSongs Env AuthToken Limit Offset SortOrder Include (Either Text GetSongsQueryResponse -> a)+  | SearchSongs Env AuthToken Text Limit Offset SortOrder Include (Either Text GetSongsQueryResponse -> a)+  | GetSong Env AuthToken UUID Include (Either Text GetSongsQueryResponse -> a)+  | CreateSong Env AuthToken InsertSongsRequest (Either Text InsertSongsCommandResponse -> a)+  | CreateSongComment Env AuthToken InsertSongCommentsRequest (Either Text InsertSongCommentsCommandResponse -> a)+  | UpsertSongOpinion Env AuthToken UpsertSongOpinionsRequest (Either Text UpsertSongOpinionsCommandResponse -> a)+  | CreateSongArtwork Env AuthToken InsertSongArtworksRequest (Either Text InsertSongArtworksCommandResponse -> a)+  | CreateArtistOfSong Env AuthToken InsertArtistsOfSongsRequest (Either Text InsertArtistsOfSongCommandResponse -> a)+  | DeleteArtistOfSong Env AuthToken InsertArtistsOfSongsRequest (Either Text () -> a)+  | DeleteSong Env AuthToken UUID (Either Text () -> a)+  | DeleteSongComment Env AuthToken UUID (Either Text () -> a)+  | DeleteSongOpinion Env AuthToken UUID (Either Text () -> a)+  | DeleteSongArtwork Env AuthToken UUID (Either Text () -> a)+  | UpdateSongArtworkOrder Env AuthToken SongArtworkOrderUpdateRequest (Either Text () -> a)+  | EditSong Env AuthToken SongDeltaRequest (Either Text () -> a)+  | CreateSongContents Env AuthToken InsertSongContentsRequest (Either Text InsertSongContentsCommandResponse -> a)+  | DeleteSongContents Env AuthToken UUID (Either Text () -> a)+  | EditSongContents Env AuthToken SongContentDeltaRequest (Either Text () -> a)+  | -- auth+    Me Env AuthToken (Either Text GetMeQueryResponse -> a)+  | UserInvite Env AuthToken InviteUsersRequest (Either Text MakeResetPasswordLinkResponse -> a)+  | UserDelete Env AuthToken DeleteUsersRequest (Either Text () -> a)+  | -- more+    Login Env LoginRequest (Either Text Text -> a)+  | ResetPassword Env Text (Either Text MakeResetPasswordLinkResponse -> a)+  | ResetPasswordDo Env DoPasswordResetRequest (Either Text () -> a)+  | SystemInformation Env (Either Text SystemInformationResponse -> a)+  deriving (Functor)++-- artists++getArtists :: (Backend :<: f) => Env -> AuthToken -> Limit -> Offset -> SortOrder -> Include -> Free f (Either Text GetArtistsQueryResponse)+getArtists env authToken limit offset sortOrder include = injectFree (GetArtists env authToken limit offset sortOrder include Pure)++searchArtists :: (Backend :<: f) => Env -> AuthToken -> Text -> Limit -> Offset -> SortOrder -> Include -> Free f (Either Text GetArtistsQueryResponse)+searchArtists env authToken search limit offset sortOrder include = injectFree (SearchArtists env authToken search limit offset sortOrder include Pure)++getArtist :: (Backend :<: f) => Env -> AuthToken -> UUID -> Include -> Free f (Either Text GetArtistsQueryResponse)+getArtist env authToken identifier include = injectFree (GetArtist env authToken identifier include Pure)++createArtist :: (Backend :<: f) => Env -> AuthToken -> InsertArtistsRequest -> Free f (Either Text InsertArtistsCommandResponse)+createArtist env authToken r = injectFree (CreateArtist env authToken r Pure)++createArtistComment :: (Backend :<: f) => Env -> AuthToken -> InsertArtistCommentsRequest -> Free f (Either Text InsertArtistCommentsCommandResponse)+createArtistComment env authToken r = injectFree (CreateArtistComment env authToken r Pure)++upsertArtistOpinion :: (Backend :<: f) => Env -> AuthToken -> UpsertArtistOpinionsRequest -> Free f (Either Text UpsertArtistOpinionsCommandResponse)+upsertArtistOpinion env authToken r = injectFree (UpsertArtistOpinion env authToken r Pure)++createArtistArtwork :: (Backend :<: f) => Env -> AuthToken -> InsertArtistArtworksRequest -> Free f (Either Text InsertArtistArtworksCommandResponse)+createArtistArtwork env authToken r = injectFree (CreateArtistArtwork env authToken r Pure)++deleteArtist :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteArtist env authToken identifier = injectFree (DeleteArtist env authToken identifier Pure)++deleteArtistComment :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteArtistComment env authToken identifier = injectFree (DeleteArtistComment env authToken identifier Pure)++deleteArtistOpinion :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteArtistOpinion env authToken identifier = injectFree (DeleteArtistOpinion env authToken identifier Pure)++deleteArtistArtwork :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteArtistArtwork env authToken identifier = injectFree (DeleteArtistArtwork env authToken identifier Pure)++updateArtistArtworkOrder :: (Backend :<: f) => Env -> AuthToken -> ArtistArtworkOrderUpdateRequest -> Free f (Either Text ())+updateArtistArtworkOrder env authToken r = injectFree (UpdateArtistArtworkOrder env authToken r Pure)++editArtist :: (Backend :<: f) => Env -> AuthToken -> ArtistDeltaRequest -> Free f (Either Text ())+editArtist env authToken r = injectFree (EditArtist env authToken r Pure)++-- genres++getGenres :: (Backend :<: f) => Env -> AuthToken -> Limit -> Offset -> SortOrder -> Include -> Free f (Either Text GetGenresQueryResponse)+getGenres env authToken limit offset sortOrder include = injectFree (GetGenres env authToken limit offset sortOrder include Pure)++searchGenres :: (Backend :<: f) => Env -> AuthToken -> Text -> Limit -> Offset -> SortOrder -> Include -> Free f (Either Text GetGenresQueryResponse)+searchGenres env authToken search limit offset sortOrder include = injectFree (SearchGenres env authToken search limit offset sortOrder include Pure)++getGenre :: (Backend :<: f) => Env -> AuthToken -> UUID -> Include -> Free f (Either Text GetGenresQueryResponse)+getGenre env authToken identifier include = injectFree (GetGenre env authToken identifier include Pure)++createGenre :: (Backend :<: f) => Env -> AuthToken -> InsertGenresRequest -> Free f (Either Text InsertGenresCommandResponse)+createGenre env authToken r = injectFree (CreateGenre env authToken r Pure)++createGenreComment :: (Backend :<: f) => Env -> AuthToken -> InsertGenreCommentsRequest -> Free f (Either Text InsertGenreCommentsCommandResponse)+createGenreComment env authToken r = injectFree (CreateGenreComment env authToken r Pure)++upsertGenreOpinion :: (Backend :<: f) => Env -> AuthToken -> UpsertGenreOpinionsRequest -> Free f (Either Text UpsertGenreOpinionsCommandResponse)+upsertGenreOpinion env authToken r = injectFree (UpsertGenreOpinion env authToken r Pure)++createGenreArtwork :: (Backend :<: f) => Env -> AuthToken -> InsertGenreArtworksRequest -> Free f (Either Text InsertGenreArtworksCommandResponse)+createGenreArtwork env authToken r = injectFree (CreateGenreArtwork env authToken r Pure)++deleteGenre :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteGenre env authToken identifier = injectFree (DeleteGenre env authToken identifier Pure)++deleteGenreComment :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteGenreComment env authToken identifier = injectFree (DeleteGenreComment env authToken identifier Pure)++deleteGenreOpinion :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteGenreOpinion env authToken identifier = injectFree (DeleteGenreOpinion env authToken identifier Pure)++deleteGenreArtwork :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteGenreArtwork env authToken identifier = injectFree (DeleteGenreArtwork env authToken identifier Pure)++updateGenreArtworkOrder :: (Backend :<: f) => Env -> AuthToken -> GenreArtworkOrderUpdateRequest -> Free f (Either Text ())+updateGenreArtworkOrder env authToken r = injectFree (UpdateGenreArtworkOrder env authToken r Pure)++editGenre :: (Backend :<: f) => Env -> AuthToken -> GenreDeltaRequest -> Free f (Either Text ())+editGenre env authToken r = injectFree (EditGenre env authToken r Pure)++-- songs++getSongs :: (Backend :<: f) => Env -> AuthToken -> Limit -> Offset -> SortOrder -> Include -> Free f (Either Text GetSongsQueryResponse)+getSongs env authToken limit offset sortOrder include = injectFree (GetSongs env authToken limit offset sortOrder include Pure)++searchSongs :: (Backend :<: f) => Env -> AuthToken -> Text -> Limit -> Offset -> SortOrder -> Include -> Free f (Either Text GetSongsQueryResponse)+searchSongs env authToken search limit offset sortOrder include = injectFree (SearchSongs env authToken search limit offset sortOrder include Pure)++getSong :: (Backend :<: f) => Env -> AuthToken -> UUID -> Include -> Free f (Either Text GetSongsQueryResponse)+getSong env authToken identifier include = injectFree (GetSong env authToken identifier include Pure)++createSong :: (Backend :<: f) => Env -> AuthToken -> InsertSongsRequest -> Free f (Either Text InsertSongsCommandResponse)+createSong env authToken r = injectFree (CreateSong env authToken r Pure)++createSongComment :: (Backend :<: f) => Env -> AuthToken -> InsertSongCommentsRequest -> Free f (Either Text InsertSongCommentsCommandResponse)+createSongComment env authToken r = injectFree (CreateSongComment env authToken r Pure)++upsertSongOpinion :: (Backend :<: f) => Env -> AuthToken -> UpsertSongOpinionsRequest -> Free f (Either Text UpsertSongOpinionsCommandResponse)+upsertSongOpinion env authToken r = injectFree (UpsertSongOpinion env authToken r Pure)++createSongArtwork :: (Backend :<: f) => Env -> AuthToken -> InsertSongArtworksRequest -> Free f (Either Text InsertSongArtworksCommandResponse)+createSongArtwork env authToken r = injectFree (CreateSongArtwork env authToken r Pure)++createArtistOfSong :: (Backend :<: f) => Env -> AuthToken -> InsertArtistsOfSongsRequest -> Free f (Either Text InsertArtistsOfSongCommandResponse)+createArtistOfSong env authToken r = injectFree (CreateArtistOfSong env authToken r Pure)++deleteArtistOfSong :: (Backend :<: f) => Env -> AuthToken -> InsertArtistsOfSongsRequest -> Free f (Either Text ())+deleteArtistOfSong env authToken r = injectFree (DeleteArtistOfSong env authToken r Pure)++deleteSong :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteSong env authToken identifier = injectFree (DeleteSong env authToken identifier Pure)++deleteSongComment :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteSongComment env authToken identifier = injectFree (DeleteSongComment env authToken identifier Pure)++deleteSongOpinion :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteSongOpinion env authToken identifier = injectFree (DeleteSongOpinion env authToken identifier Pure)++deleteSongArtwork :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteSongArtwork env authToken identifier = injectFree (DeleteSongArtwork env authToken identifier Pure)++updateSongArtworkOrder :: (Backend :<: f) => Env -> AuthToken -> SongArtworkOrderUpdateRequest -> Free f (Either Text ())+updateSongArtworkOrder env authToken r = injectFree (UpdateSongArtworkOrder env authToken r Pure)++editSong :: (Backend :<: f) => Env -> AuthToken -> SongDeltaRequest -> Free f (Either Text ())+editSong env authToken r = injectFree (EditSong env authToken r Pure)++createSongContents :: (Backend :<: f) => Env -> AuthToken -> InsertSongContentsRequest -> Free f (Either Text InsertSongContentsCommandResponse)+createSongContents env authToken r = injectFree (CreateSongContents env authToken r Pure)++deleteSongContents :: (Backend :<: f) => Env -> AuthToken -> UUID -> Free f (Either Text ())+deleteSongContents env authToken identifier = injectFree (DeleteSongContents env authToken identifier Pure)++editSongContents :: (Backend :<: f) => Env -> AuthToken -> SongContentDeltaRequest -> Free f (Either Text ())+editSongContents env authToken r = injectFree (EditSongContents env authToken r Pure)++me :: (Backend :<: f) => Env -> AuthToken -> Free f (Either Text GetMeQueryResponse)+me env authToken = injectFree (Me env authToken Pure)++userInvite :: (Backend :<: f) => Env -> AuthToken -> InviteUsersRequest -> Free f (Either Text MakeResetPasswordLinkResponse)+userInvite env authToken r = injectFree (UserInvite env authToken r Pure)++userDelete :: (Backend :<: f) => Env -> AuthToken -> DeleteUsersRequest -> Free f (Either Text ())+userDelete env authToken r = injectFree (UserDelete env authToken r Pure)++-- more+login :: (Backend :<: f) => Env -> LoginRequest -> Free f (Either Text Text)+login env loginRequest = injectFree (Login env loginRequest Pure)++resetPassword :: (Backend :<: f) => Env -> Text -> Free f (Either Text MakeResetPasswordLinkResponse)+resetPassword env r = injectFree (ResetPassword env r Pure)++resetPasswordDo :: (Backend :<: f) => Env -> DoPasswordResetRequest -> Free f (Either Text ())+resetPasswordDo env r = injectFree (ResetPasswordDo env r Pure)++systemInformation :: (Backend :<: f) => Env -> Free f (Either Text SystemInformationResponse)+systemInformation env = injectFree (SystemInformation env Pure)
+ src/WikiMusic/SSR/Free/Clock.hs view
@@ -0,0 +1,22 @@+module WikiMusic.SSR.Free.Clock+  ( timeElapsedUntilNow,+    now,+    Clock (..),+  )+where++import Data.Time+import Free.AlaCarte+import Relude++type Clock :: Type -> Type+data Clock a+  = TimeElapsedUntilNow UTCTime (Text -> a)+  | Now (UTCTime -> a)+  deriving (Functor)++timeElapsedUntilNow :: (Clock :<: f) => UTCTime -> Free f Text+timeElapsedUntilNow fromTime = injectFree (TimeElapsedUntilNow fromTime Pure)++now :: (Clock :<: f) => Free f UTCTime+now = injectFree (Now Pure)
+ src/WikiMusic/SSR/Free/Logger.hs view
@@ -0,0 +1,26 @@+module WikiMusic.SSR.Free.Logger+  ( logInfo,+    logError,+    logDebug,+    Logger (..),+  )+where++import Free.AlaCarte+import Relude++type Logger :: Type -> Type+data Logger a+  = LogInfo Text a+  | LogError Text a+  | LogDebug Text a+  deriving (Functor)++logInfo :: (Logger :<: f) => Text -> Free f ()+logInfo message = injectFree (LogInfo message (Pure ()))++logError :: (Logger :<: f) => Text -> Free f ()+logError message = injectFree (LogError message (Pure ()))++logDebug :: (Logger :<: f) => Text -> Free f ()+logDebug message = injectFree (LogDebug message (Pure ()))
+ src/WikiMusic/SSR/Free/View.hs view
@@ -0,0 +1,72 @@+module WikiMusic.SSR.Free.View+  ( artistListPage,+    View (..),+    errorPage,+    loginPage,+    genreListPage,+    artistDetailPage,+    genreDetailPage,+    songListPage,+    songDetailPage,+    artistCreatePage,+    genreCreatePage,+    songCreatePage,+  )+where++import Free.AlaCarte+import Relude+import Text.Blaze.Html+import WikiMusic.Interaction.Model.Artist+import WikiMusic.Interaction.Model.Genre+import WikiMusic.Interaction.Model.Song+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env++type View :: Type -> Type+data View a+  = ArtistListPage Env UiMode Language Palette SortOrder GetArtistsQueryResponse (Html -> a)+  | ArtistDetailPage Env UiMode Language Palette GetArtistsQueryResponse (Html -> a)+  | ArtistCreatePage Env UiMode Language Palette (Html -> a)+  | GenreListPage Env UiMode Language Palette SortOrder GetGenresQueryResponse (Html -> a)+  | GenreDetailPage Env UiMode Language Palette GetGenresQueryResponse (Html -> a)+  | GenreCreatePage Env UiMode Language Palette (Html -> a)+  | SongListPage Env UiMode Language Palette SortOrder GetSongsQueryResponse (Html -> a)+  | SongDetailPage Env UiMode Language Palette SongAsciiSize GetSongsQueryResponse (Html -> a)+  | SongCreatePage Env UiMode Language Palette (Html -> a)+  | ErrorPage Env UiMode Language Palette Text (Html -> a)+  | LoginPage Env UiMode Language Palette (Html -> a)+  deriving (Functor)++artistListPage :: (View :<: f) => Env -> UiMode -> Language -> Palette -> SortOrder -> GetArtistsQueryResponse -> Free f Html+artistListPage env mode language palette sortOrder artists = injectFree (ArtistListPage env mode language palette sortOrder artists Pure)++artistDetailPage :: (View :<: f) => Env -> UiMode -> Language -> Palette -> GetArtistsQueryResponse -> Free f Html+artistDetailPage env mode language palette artists = injectFree (ArtistDetailPage env mode language palette artists Pure)++artistCreatePage :: (View :<: f) => Env -> UiMode -> Language -> Palette -> Free f Html+artistCreatePage env mode language palette = injectFree (ArtistCreatePage env mode language palette Pure)++genreListPage :: (View :<: f) => Env -> UiMode -> Language -> Palette -> SortOrder -> GetGenresQueryResponse -> Free f Html+genreListPage env mode language palette sortOrder genres = injectFree (GenreListPage env mode language palette sortOrder genres Pure)++genreDetailPage :: (View :<: f) => Env -> UiMode -> Language -> Palette -> GetGenresQueryResponse -> Free f Html+genreDetailPage env mode language palette genres = injectFree (GenreDetailPage env mode language palette genres Pure)++genreCreatePage :: (View :<: f) => Env -> UiMode -> Language -> Palette -> Free f Html+genreCreatePage env mode language palette = injectFree (GenreCreatePage env mode language palette Pure)++songListPage :: (View :<: f) => Env -> UiMode -> Language -> Palette -> SortOrder -> GetSongsQueryResponse -> Free f Html+songListPage env mode language palette sortOrder songs = injectFree (SongListPage env mode language palette sortOrder songs Pure)++songDetailPage :: (View :<: f) => Env -> UiMode -> Language -> Palette -> SongAsciiSize -> GetSongsQueryResponse -> Free f Html+songDetailPage env mode language palette songAsciiSize songs = injectFree (SongDetailPage env mode language palette songAsciiSize songs Pure)++songCreatePage :: (View :<: f) => Env -> UiMode -> Language -> Palette -> Free f Html+songCreatePage env mode language palette = injectFree (SongCreatePage env mode language palette Pure)++errorPage :: (View :<: f) => Env -> UiMode -> Language -> Palette -> Text -> Free f Html+errorPage env mode message l palette = injectFree (ErrorPage env mode message l palette Pure)++loginPage :: (View :<: f) => Env -> UiMode -> Language -> Palette -> Free f Html+loginPage env mode language palette = injectFree (LoginPage env mode language palette Pure)
+ src/WikiMusic/SSR/Language.hs view
@@ -0,0 +1,241 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoFieldSelectors #-}++module WikiMusic.SSR.Language+  ( DictTerm (..),+    Titles (..),+    Errors (..),+    Slogans (..),+    LanguageDict (..),+    More (..),+    Forms (..),+    Sortings (..),+    towerOfBabel,+    dictionary,+    (|##|),+  )+where++import Data.Text (unpack)+import Optics+import Relude+import WikiMusic.SSR.Model.Api++data DictTerm = DictTerm+  { en :: Text,+    nl :: Text+  }+  deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''DictTerm++data Titles = Titles+  { wikimusicSSR :: DictTerm,+    errorOccurred :: DictTerm,+    artistsPage :: DictTerm,+    genresPage :: DictTerm,+    songsPage :: DictTerm,+    login :: DictTerm+  }+  deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''Titles++data Errors = Errors+  { clientError :: DictTerm+  }+  deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''Errors++data More = More+  { likes :: DictTerm,+    dislikes :: DictTerm,+    artistsNav :: DictTerm,+    genresNav :: DictTerm,+    songsNav :: DictTerm,+    loginNav :: DictTerm,+    views :: DictTerm,+    warningHeavyDevelopment :: DictTerm,+    createdBy :: DictTerm,+    createdAt :: DictTerm,+    lastEditedAt :: DictTerm,+    musicTuning :: DictTerm,+    musicKey :: DictTerm,+    musicCreationDate :: DictTerm,+    albumName :: DictTerm,+    albumInfoLink :: DictTerm+  }+  deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''More++data Slogans = Slogans+  { pageTop :: DictTerm+  }+  deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''Slogans++data Forms = Forms+  { email :: DictTerm,+    password :: DictTerm,+    submit :: DictTerm+  }+  deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''Forms++data Sortings = Sortings+  { alphabeticalAsc :: DictTerm,+    alphabeticalDesc :: DictTerm,+    createdAtAsc :: DictTerm,+    createdAtDesc :: DictTerm+  }+  deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''Sortings++data Buttons = Buttons+  { edit :: DictTerm,+    delete :: DictTerm,+    like :: DictTerm,+    dislike :: DictTerm+  }+  deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''Buttons++data LanguageDict = LanguageDict+  { titles :: Titles,+    errors :: Errors,+    slogans :: Slogans,+    more :: More,+    forms :: Forms,+    sortings :: Sortings,+    buttons :: Buttons+  }+  deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''LanguageDict++dictionary :: LanguageDict+dictionary =+  LanguageDict+    { titles =+        Titles+          { wikimusicSSR = DictTerm {en = "WikiMusic", nl = "WikiMusic"},+            errorOccurred = DictTerm {en = "Error occurred!", nl = "Fout opgetreden"},+            artistsPage = DictTerm {en = "Artists", nl = "Artiesten"},+            genresPage = DictTerm {en = "Genres", nl = "Genres"},+            songsPage = DictTerm {en = "Songs", nl = "Nummers"},+            login = DictTerm {en = "Login", nl = "Inloggen"}+          },+      forms =+        Forms+          { email = DictTerm {en = "email address:", nl = "emailadres:"},+            password = DictTerm {en = "password:", nl = "wachtwoord:"},+            submit = DictTerm {en = "submit", nl = "indienen"}+          },+      errors =+        Errors+          { clientError = DictTerm {en = "Client error!", nl = "Client error!"}+          },+      buttons =+        Buttons+          { edit = DictTerm {en = "edit", nl = "bewerken"},+            delete = DictTerm {en = "delete", nl = "verwijderen"},+            like = DictTerm {en = "like", nl = "leuk"},+            dislike = DictTerm {en = "dislike", nl = "niet leuk"}+          },+      slogans =+        Slogans+          { pageTop =+              DictTerm+                { en = "Welcome to the music knowledge sharing community 🎼",+                  nl = "Welkom bij de gemeenschap waar je muziek kennis kan delen 🎼"+                }+          },+      sortings =+        Sortings+          { alphabeticalAsc = DictTerm {en = "alphabetical - asc", nl = "alfabetisch - opl"},+            alphabeticalDesc = DictTerm {en = "alphabetical - desc", nl = "alfabetisch - afl"},+            createdAtAsc = DictTerm {en = "created at - asc", nl = "datum gemaakt - opl"},+            createdAtDesc = DictTerm {en = "created at - desc", nl = "datum gemaakt - afl"}+          },+      more =+        More+          { likes =+              DictTerm+                { en = "likes",+                  nl = "leuks"+                },+            dislikes =+              DictTerm+                { en = "dislikes",+                  nl = "niet leuks"+                },+            artistsNav =+              DictTerm+                { en = "Artists",+                  nl = "Artiesten"+                },+            genresNav =+              DictTerm+                { en = "Genres",+                  nl = "Genres"+                },+            songsNav =+              DictTerm+                { en = "Songs",+                  nl = "Nummers"+                },+            loginNav =+              DictTerm+                { en = "Login",+                  nl = "Inloggen"+                },+            views =+              DictTerm+                { en = "views",+                  nl = "weergaven"+                },+            createdBy =+              DictTerm+                { en = "added by:",+                  nl = "toegevoeg door:"+                },+            createdAt =+              DictTerm+                { en = "date created:",+                  nl = "datum gemaakt:"+                },+            lastEditedAt =+              DictTerm+                { en = "last edited at:",+                  nl = "laatst bijgewerkt:"+                },+            warningHeavyDevelopment = DictTerm {en = "Warning! WikiMusic is ongoing an experimental stage! Certain features will not work and are being fixed.", nl = "Let op! WikiMusic is momenteel in een experimentele periode. Hou rekening met de feit dat sommige functies niet zullen werken, er wordt aan gewerkt. "},+            musicTuning = DictTerm {en = "tuning:", nl = "stemming:"},+            musicKey = DictTerm {en = "music key:", nl = "muziek key:"},+            musicCreationDate = DictTerm {en = "music creation:", nl = "muziek geschreven:"},+            albumName = DictTerm {en = "album name:", nl = "album naam:"},+            albumInfoLink = DictTerm {en = "album info:", nl = "info over album:"}+          }+    }++translateTerm :: Text -> DictTerm -> Text+translateTerm "nl" x = x ^. #nl+translateTerm _ x = x ^. #en++towerOfBabel :: Language -> DictTerm -> Text+towerOfBabel language x = fromString . unpack $ translateTerm (language ^. #value) x++-- towerOfBabel alias+infixl 8 |##|++(|##|) :: DictTerm -> Language -> Text+(|##|) x language = towerOfBabel language x
+ src/WikiMusic/SSR/Model/Api.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoFieldSelectors #-}++module WikiMusic.SSR.Model.Api+  ( AuthToken (..),+    SortOrder (..),+    Include (..),+    UiMode (..),+    Language (..),+    Palette (..),+    authCookieName,+    localeCookieName,+    uiModeCookieName,+    ViewVars (..),+    artistSortingCookieName,+    songSortingCookieName,+    genreSortingCookieName,+    songAsciiSizeCookieName,+    paletteCookieName,+    SongAsciiSize (..),+  )+where++import Optics+import Relude++newtype AuthToken = AuthToken {value :: Text} deriving (Eq, Generic, Show)++newtype SortOrder = SortOrder {value :: Text} deriving (Eq, Generic, Show)++newtype Include = Include {value :: Text} deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''AuthToken+makeFieldLabelsNoPrefix ''SortOrder+makeFieldLabelsNoPrefix ''Include++newtype Language = Language {value :: Text} deriving (Eq, Generic, Show)++newtype UiMode = UiMode {value :: Text} deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''Language+makeFieldLabelsNoPrefix ''UiMode++newtype SongAsciiSize = SongAsciiSize {value :: Text} deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''SongAsciiSize++newtype Palette = Palette {value :: Text} deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''Palette++localeCookieName :: Text+localeCookieName = "wikimusic-locale"++uiModeCookieName :: Text+uiModeCookieName = "wikimusic-ui-mode"++songAsciiSizeCookieName :: Text+songAsciiSizeCookieName = "wikimusic-song-ascii-size"++authCookieName :: Text+authCookieName = "wikimusic-auth"++artistSortingCookieName :: Text+artistSortingCookieName = "wikimusic-artist-sorting"++songSortingCookieName :: Text+songSortingCookieName = "wikimusic-song-sorting"++genreSortingCookieName :: Text+genreSortingCookieName = "wikimusic-genre-sorting"++paletteCookieName :: Text+paletteCookieName = "wikimusic-palette"++data ViewVars = ViewVars+  { locale :: Language,+    uiMode :: UiMode,+    authToken :: AuthToken,+    songSorting :: SortOrder,+    artistSorting :: SortOrder,+    genreSorting :: SortOrder,+    songAsciiSize :: SongAsciiSize,+    palette :: Palette+  }+  deriving (Eq, Generic, Show)++makeFieldLabelsNoPrefix ''ViewVars
+ src/WikiMusic/SSR/Model/Config.hs view
@@ -0,0 +1,122 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoFieldSelectors #-}++module WikiMusic.SSR.Model.Config+  ( AppConfig (..),+    ServantConfig (..),+    CorsConfig (..),+    CookieConfig (..),+    WebFrontendConfig (..),+    appConfigCodec,+  )+where++import Optics+import Relude+import Toml++data ServantConfig = ServantConfig+  { port :: Int,+    host :: Text+  }+  deriving (Generic, Eq, Show)++servantConfigCodec :: TomlCodec ServantConfig+servantConfigCodec =+  ServantConfig+    <$> Toml.int "port"+    .= (^. #port)+    <*> Toml.text "host"+    .= (^. #host)++data CorsConfig = CorsConfig+  { origins :: [Text],+    methods :: [Text],+    requestHeaders :: [Text]+  }+  deriving (Generic, Eq, Show)++corsConfigCodec :: TomlCodec CorsConfig+corsConfigCodec =+  CorsConfig+    <$> Toml.arrayOf Toml._Text "origins"+    .= (^. #origins)+    <*> Toml.arrayOf Toml._Text "methods"+    .= (^. #methods)+    <*> Toml.arrayOf Toml._Text "request-headers"+    .= (^. #requestHeaders)++data CookieConfig = CookieConfig+  { maxAge :: Int,+    path :: Text,+    domain :: Text,+    secure :: Bool,+    sameSite :: Text+  }+  deriving (Generic, Eq, Show)++cookieConfigCodec :: TomlCodec CookieConfig+cookieConfigCodec =+  CookieConfig+    <$> Toml.int "max-age"+    .= (^. #maxAge)+    <*> Toml.text "path"+    .= (^. #path)+    <*> Toml.text "domain"+    .= (^. #domain)+    <*> Toml.bool "secure"+    .= (^. #secure)+    <*> Toml.text "same-site"+    .= (^. #sameSite)++newtype DevConfig = DevConfig+  { reportedVersion :: Text+  }+  deriving (Generic, Eq, Show)++devCodec :: TomlCodec DevConfig+devCodec = DevConfig <$> Toml.text "reported-version" .= (^. #reportedVersion)++newtype WebFrontendConfig = WebFrontendConfig+  { baseUrl :: Text+  }+  deriving (Generic, Eq, Show)++webFrontendConfigCodec :: TomlCodec WebFrontendConfig+webFrontendConfigCodec =+  WebFrontendConfig+    <$> Toml.text "base-url"+    .= (^. #baseUrl)++data AppConfig = AppConfig+  { servant :: ServantConfig,+    cors :: CorsConfig,+    cookie :: CookieConfig,+    webFrontend :: WebFrontendConfig,+    dev :: DevConfig+  }+  deriving (Generic, Eq, Show)++appConfigCodec :: TomlCodec AppConfig+appConfigCodec =+  AppConfig+    <$> Toml.table servantConfigCodec "servant"+    .= (^. #servant)+    <*> Toml.table corsConfigCodec "cors"+    .= (^. #cors)+    <*> Toml.table cookieConfigCodec "cookie"+    .= (^. #cookie)+    <*> Toml.table webFrontendConfigCodec "web-frontend"+    .= (^. #webFrontend)+    <*> Toml.table devCodec "dev"+    .= (^. #dev)++makeFieldLabelsNoPrefix ''AppConfig+makeFieldLabelsNoPrefix ''ServantConfig+makeFieldLabelsNoPrefix ''CorsConfig+makeFieldLabelsNoPrefix ''CookieConfig+makeFieldLabelsNoPrefix ''WebFrontendConfig+makeFieldLabelsNoPrefix ''DevConfig
+ src/WikiMusic/SSR/Model/Env.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE NoFieldSelectors #-}++module WikiMusic.SSR.Model.Env+  ( Env (..),+    PalettesCss (..),+  )+where++import Data.Text+import Data.Time+import Optics+import Servant.Client+import WikiMusic.SSR.Model.Config++data PalettesCss = PalettesCss+  { green :: Text,+    mauve :: Text+  }++makeFieldLabelsNoPrefix ''PalettesCss++data Env = Env+  { cfg :: AppConfig,+    processStartedAt :: ZonedTime,+    reportedVersion :: Text,+    mainCss :: Text,+    darkCss :: Text,+    lightCss :: Text,+    clientEnv :: ClientEnv,+    palettes :: PalettesCss+  }++makeFieldLabelsNoPrefix ''Env
+ src/WikiMusic/SSR/Prelude.hs view
@@ -0,0 +1,1 @@+module WikiMusic.SSR.Prelude where
+ src/WikiMusic/SSR/Servant/ApiSetup.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE OverloadedLabels #-}++module WikiMusic.SSR.Servant.ApiSetup (mkApp) where++import Data.Text qualified as T+import Data.Time+import Network.HTTP.Client (newManager)+import Network.HTTP.Client.TLS (tlsManagerSettings)+import Network.Wai+import Network.Wai.Middleware.Cors+import Optics+import Relude+import Servant+import Servant.Client+import WikiMusic.SSR.Backend.Rest ()+import WikiMusic.SSR.Model.Config+import WikiMusic.SSR.Model.Env+import WikiMusic.SSR.Servant.ApiSpec+import WikiMusic.SSR.Servant.ArtistRoutes+import WikiMusic.SSR.Servant.GenreRoutes+import WikiMusic.SSR.Servant.LoginRoutes+import WikiMusic.SSR.Servant.PreferenceRoutes+import WikiMusic.SSR.Servant.SongRoutes+import WikiMusic.SSR.View.Html ()++newClientEnv :: (MonadIO m) => m ClientEnv+newClientEnv = do+  manager <- liftIO $ newManager tlsManagerSettings+  pure $ clientEnv manager Nothing+  where+    baseUrl' =+      BaseUrl+        { baseUrlScheme = Https,+          baseUrlHost = "api.wikimusic.jointhefreeworld.org",+          baseUrlPort = 443,+          baseUrlPath = ""+        }+    clientEnv manager cookieJar =+      ClientEnv+        { manager = manager,+          baseUrl = baseUrl',+          cookieJar = cookieJar,+          makeClientRequest = defaultMakeClientRequest+        }++mkApp :: AppConfig -> IO Application+mkApp cfg = do+  let apiCfg = EmptyContext+  now <- getZonedTime+  mainCss <- liftIO (readFileBS "resources/css/main.css")+  lightCss <- liftIO (readFileBS "resources/css/light.css")+  darkCss <- liftIO (readFileBS "resources/css/dark.css")+  greenPaletteCss <- liftIO (readFileBS "resources/css/palettes/green.css")+  mauvePaletteCss <- liftIO (readFileBS "resources/css/palettes/mauve.css")+  clientEnv <- newClientEnv+  let env =+        Env+          { cfg = cfg,+            processStartedAt = now,+            reportedVersion = cfg ^. #dev % #reportedVersion,+            mainCss = prepareCSS mainCss,+            darkCss = prepareCSS darkCss,+            lightCss = prepareCSS lightCss,+            clientEnv = clientEnv,+            palettes =+              PalettesCss+                { green = prepareCSS greenPaletteCss,+                  mauve = prepareCSS mauvePaletteCss+                }+          }+  pure+    . myCors (cfg ^. #cors)+    $ serveWithContext wikimusicSSRServant apiCfg (server env)+  where+    prepareCSS = T.filter (\x -> x /= '\n' && x /= '\t') . decodeUtf8++server :: Env -> Server WikiMusicSSRServant+server env =+  fallbackRoute+    :<|> artistsRoute env+    :<|> artistRoute env+    :<|> artistCreateRoute env+    :<|> artistCreateFormRoute env+    :<|> artistLikeRoute env+    :<|> artistDislikeRoute env+    :<|> genresRoute env+    :<|> genreRoute env+    :<|> genreCreateRoute env+    :<|> songsRoute env+    :<|> songRoute env+    :<|> songCreateRoute env+    :<|> setLanguageRoute env+    :<|> setArtistSortingRoute env+    :<|> setGenreSortingRoute env+    :<|> setSongSortingRoute env+    :<|> setDarkModeRoute env+    :<|> setSongAsciiSizeRoute env+    :<|> setPaletteRoute env+    :<|> loginFormRoute env+    :<|> submitLoginRoute env++fallbackRoute :: Handler a+fallbackRoute =+  do+    throwError+    $ ServerError+      { errHTTPCode = 302,+        errReasonPhrase = "Found",+        errBody = "",+        errHeaders = [("Location", "/songs")]+      }++wikimusicSSRServant :: Proxy WikiMusicSSRServant+wikimusicSSRServant = Proxy++myCors :: CorsConfig -> Middleware+myCors cfg = cors (const $ Just policy)+  where+    policy =+      CorsResourcePolicy+        { corsOrigins = Just (map (fromString . T.unpack) (cfg ^. #origins), True),+          corsMethods = map (fromString . T.unpack) (cfg ^. #methods),+          corsRequestHeaders = map (fromString . T.unpack) (cfg ^. #requestHeaders),+          corsExposedHeaders =+            Just+              [ "content-type",+                "date",+                "content-length",+                "access-control-allow-origin",+                "access-control-allow-methods",+                "access-control-allow-headers",+                "access-control-request-method",+                "access-control-request-headers"+              ],+          corsMaxAge = Nothing,+          corsVaryOrigin = False,+          corsRequireOrigin = False,+          corsIgnoreFailures = False+        }
+ src/WikiMusic/SSR/Servant/ApiSpec.hs view
@@ -0,0 +1,65 @@+module WikiMusic.SSR.Servant.ApiSpec (WikiMusicSSRServant) where++import Data.UUID (UUID)+import Relude+import Servant+import Servant.HTML.Blaze as ServantBlaze+import Servant.Multipart+import Text.Blaze.Html as Html+import WikiMusic.SSR.Backend.Rest ()+import WikiMusic.SSR.View.Html ()++type WikiMusicSSRServant =+  Get '[ServantBlaze.HTML] NoContent+    :<|> "artists"+      :> WithCookie+      :> QueryParam "sort-order" Text+      :> QueryParam "limit" Int+      :> QueryParam "offset" Int+      :> GetHtml+    :<|> "artists" :> WithCookie :> Capture "identifier" UUID :> GetHtml+    :<|> "artists" :> "create" :> WithCookie :> GetHtml+    :<|> "artists" :> "create" :> WithCookie :> PostDataForm+    :<|> "artists" :> "like" :> WithCookie :> WithReferer :> Capture "identifier" UUID :> PostNoFields+    :<|> "artists" :> "dislike" :> WithCookie :> WithReferer :> Capture "identifier" UUID :> PostNoFields+    :<|> "genres"+      :> WithCookie+      :> QueryParam "sort-order" Text+      :> QueryParam "limit" Int+      :> QueryParam "offset" Int+      :> GetHtml+    :<|> "genres" :> WithCookie :> Capture "identifier" UUID :> GetHtml+    :<|> "genres" :> "create" :> WithCookie :> GetHtml+    :<|> "songs"+      :> WithCookie+      :> QueryParam "sort-order" Text+      :> QueryParam "limit" Int+      :> QueryParam "offset" Int+      :> GetHtml+    :<|> "songs" :> WithCookie :> Capture "identifier" UUID :> GetHtml+    :<|> "songs" :> "create" :> WithCookie :> GetHtml+    :<|> "user-preferences" :> "locale" :> WithReferer :> CookieForm+    :<|> "user-preferences" :> "artist-sorting" :> WithReferer :> CookieForm+    :<|> "user-preferences" :> "genre-sorting" :> WithReferer :> CookieForm+    :<|> "user-preferences" :> "song-sorting" :> WithReferer :> CookieForm+    :<|> "user-preferences" :> "dark-mode" :> WithReferer :> CookieForm+    :<|> "user-preferences" :> "song-ascii-size" :> WithReferer :> CookieForm+    :<|> "user-preferences" :> "palette" :> WithReferer :> CookieForm+    :<|> "login" :> WithCookie :> GetHtml+    :<|> "login" :> CookieForm++type PostDataForm =+  MultipartForm Mem (MultipartData Mem)+    :> Post '[ServantBlaze.HTML] (Headers '[Header "Location" Text] NoContent)++type PostNoFields = Post '[ServantBlaze.HTML] (Headers '[Header "Location" Text] NoContent)++type CookieForm =+  MultipartForm Mem (MultipartData Mem)+    :> Post '[ServantBlaze.HTML] (Headers '[Header "Set-Cookie" Text, Header "Location" Text] NoContent)++type GetHtml = Get '[ServantBlaze.HTML] Html++type WithCookie = Header "cookie" Text++type WithReferer = Header "referer" Text
+ src/WikiMusic/SSR/Servant/ArtistRoutes.hs view
@@ -0,0 +1,158 @@+{-# LANGUAGE OverloadedLabels #-}++module WikiMusic.SSR.Servant.ArtistRoutes+  ( artistsRoute,+    artistRoute,+    artistCreateRoute,+    artistCreateFormRoute,+    artistLikeRoute,+    artistDislikeRoute,+  )+where++import Control.Monad.Error.Class+import Data.ByteString.Lazy qualified as BL+import Data.Text qualified as T+import Data.UUID (UUID)+import Free.AlaCarte+import Optics+import Relude+import Servant+import Servant.Multipart+import Text.Blaze.Html as Html+import WikiMusic.Interaction.Model.Artist+import WikiMusic.Model.Other+import WikiMusic.SSR.Backend.Rest ()+import WikiMusic.SSR.Free.Backend+import WikiMusic.SSR.Free.View+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env+import WikiMusic.SSR.Servant.Utilities+import WikiMusic.SSR.View.Html ()++artistsRoute :: (MonadIO m) => Env -> Maybe Text -> Maybe Text -> Maybe Int -> Maybe Int -> m Html+artistsRoute env cookie givenSortOrder limit offset = do+  maybeArtists <-+    liftIO+      $ exec @Backend+        ( getArtists+            env+            (viewVars ^. #authToken)+            (maybe (Limit 50) Limit limit)+            (maybe (Offset 0) Offset offset)+            sortOrder+            (Include {value = "artworks,comments,opinions"})+        )+  eitherView+    env+    (viewVars ^. #uiMode)+    (viewVars ^. #locale)+    (viewVars ^. #palette)+    maybeArtists+    (exec @View . artistListPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette) sortOrder)+  where+    viewVars = viewVarsFromCookies cookie+    sortOrder = maybe (viewVars ^. #artistSorting) SortOrder givenSortOrder++artistRoute :: (MonadIO m) => Env -> Maybe Text -> UUID -> m Html+artistRoute env cookie identifier = do+  maybeArtists <-+    liftIO+      $ exec @Backend+        ( getArtist+            env+            (viewVars ^. #authToken)+            identifier+            (Include {value = "artworks,comments,opinions"})+        )+  eitherView+    env+    (viewVars ^. #uiMode)+    (viewVars ^. #locale)+    (viewVars ^. #palette)+    maybeArtists+    (exec @View . artistDetailPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette))+  where+    viewVars = viewVarsFromCookies cookie++artistCreateRoute :: (MonadIO m) => Env -> Maybe Text -> m Html+artistCreateRoute env cookie = do+  liftIO $ exec @View (artistCreatePage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette))+  where+    viewVars = viewVarsFromCookies cookie++artistCreateFormRoute :: (MonadIO m, MonadError ServerError m) => Env -> Maybe Text -> MultipartData tag -> m a+artistCreateFormRoute env cookie multipartData = do+  createResult <- liftIO $ exec @Backend (createArtist env (viewVars ^. #authToken) r)+  _ <- liftIO $ BL.putStr (fromString . show $ createResult)+  throwError+    $ ServerError+      { errHTTPCode = 302,+        errReasonPhrase = "Found",+        errBody = "",+        errHeaders =+          [("Location", "/artists")]+      }+  where+    viewVars = viewVarsFromCookies cookie+    r =+      InsertArtistsRequest+        { artists =+            [ InsertArtistsRequestItem+                { displayName = fromForm multipartData "" "displayName",+                  spotifyUrl = maybeFromForm multipartData "spotifyUrl",+                  youtubeUrl = maybeFromForm multipartData "youtubeUrl",+                  soundcloudUrl = maybeFromForm multipartData "soundcloudUrl",+                  wikipediaUrl = maybeFromForm multipartData "wikipediaUrl",+                  description = maybeFromForm multipartData "description"+                }+            ]+        }++artistLikeRoute :: (MonadIO m, MonadError ServerError m) => Env -> Maybe Text -> Maybe Text -> UUID -> m a+artistLikeRoute env cookie maybeReferer identifier = do+  res <- liftIO $ exec @Backend (upsertArtistOpinion env (viewVars ^. #authToken) r)+  _ <- liftIO $ BL.putStr (fromString . show $ res)+  throwError+    $ ServerError+      { errHTTPCode = 302,+        errReasonPhrase = "Found",+        errBody = "",+        errHeaders =+          [("Location", fromString . T.unpack $ fromMaybe "/artists" maybeReferer)]+      }+  where+    viewVars = viewVarsFromCookies cookie+    r =+      UpsertArtistOpinionsRequest+        { artistOpinions =+            [ UpsertArtistOpinionsRequestItem+                { artistIdentifier = identifier,+                  isLike = True+                }+            ]+        }++artistDislikeRoute :: (MonadIO m, MonadError ServerError m) => Env -> Maybe Text -> Maybe Text -> UUID -> m a+artistDislikeRoute env cookie maybeReferer identifier = do+  res <- liftIO $ exec @Backend (upsertArtistOpinion env (viewVars ^. #authToken) r)+  _ <- liftIO $ BL.putStr (fromString . show $ res)+  throwError+    $ ServerError+      { errHTTPCode = 302,+        errReasonPhrase = "Found",+        errBody = "",+        errHeaders =+          [("Location", fromString . T.unpack $ fromMaybe "/artists" maybeReferer)]+      }+  where+    viewVars = viewVarsFromCookies cookie+    r =+      UpsertArtistOpinionsRequest+        { artistOpinions =+            [ UpsertArtistOpinionsRequestItem+                { artistIdentifier = identifier,+                  isLike = False+                }+            ]+        }
+ src/WikiMusic/SSR/Servant/GenreRoutes.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedLabels #-}++module WikiMusic.SSR.Servant.GenreRoutes+  ( genresRoute,+    genreRoute,+    genreCreateRoute,+  )+where++import Data.UUID (UUID)+import Free.AlaCarte+import Optics+import Relude+import Text.Blaze.Html as Html+import WikiMusic.Model.Other+import WikiMusic.SSR.Backend.Rest ()+import WikiMusic.SSR.Free.Backend+import WikiMusic.SSR.Free.View+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env+import WikiMusic.SSR.Servant.Utilities+import WikiMusic.SSR.View.Html ()++genresRoute :: (MonadIO m) => Env -> Maybe Text -> Maybe Text -> Maybe Int -> Maybe Int -> m Html+genresRoute env cookie givenSortOrder limit offset = do+  maybeGenres <-+    liftIO+      $ exec @Backend+        ( getGenres+            env+            (viewVars ^. #authToken)+            (maybe (Limit 50) Limit limit)+            (maybe (Offset 0) Offset offset)+            sortOrder+            (Include {value = "artworks,comments,opinions"})+        )+  eitherView+    env+    (viewVars ^. #uiMode)+    (viewVars ^. #locale)+    (viewVars ^. #palette)+    maybeGenres+    (exec @View . genreListPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette) sortOrder)+  where+    viewVars = viewVarsFromCookies cookie+    sortOrder = maybe (viewVars ^. #genreSorting) SortOrder givenSortOrder++genreRoute :: (MonadIO m) => Env -> Maybe Text -> UUID -> m Html+genreRoute env cookie identifier = do+  maybeGenres <-+    liftIO+      $ exec @Backend+        ( getGenre+            env+            (viewVars ^. #authToken)+            identifier+            (Include {value = "artworks,comments,opinions"})+        )+  eitherView+    env+    (viewVars ^. #uiMode)+    (viewVars ^. #locale)+    (viewVars ^. #palette)+    maybeGenres+    (exec @View . genreDetailPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette))+  where+    viewVars = viewVarsFromCookies cookie++genreCreateRoute :: (MonadIO m) => Env -> Maybe Text -> m Html+genreCreateRoute env cookie = do+  liftIO $ exec @View (genreCreatePage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette))+  where+    viewVars = viewVarsFromCookies cookie
+ src/WikiMusic/SSR/Servant/LoginRoutes.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedLabels #-}++module WikiMusic.SSR.Servant.LoginRoutes (submitLoginRoute, loginFormRoute) where++import Control.Monad.Error.Class+import Data.ByteString.Lazy qualified as BL+import Data.Map qualified as Map+import Data.Text qualified as T+import Free.AlaCarte+import Optics+import Relude+import Servant+import Servant.Multipart+import Text.Blaze.Html as Html+import WikiMusic.Model.Auth+import WikiMusic.SSR.Backend.Rest ()+import WikiMusic.SSR.Free.Backend+import WikiMusic.SSR.Free.View+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env+import WikiMusic.SSR.Servant.Utilities+import WikiMusic.SSR.View.Html ()++submitLoginRoute :: (MonadIO m, MonadError ServerError m) => Env -> MultipartData tag -> m a+submitLoginRoute env multipartData = do+  maybeAuthToken <- liftIO $ exec @Backend (login env (LoginRequest {wikimusicEmail = email, wikimusicPassword = password}))+  case maybeAuthToken of+    Left e -> do+      _ <- liftIO $ BL.putStr . fromString . T.unpack $ e+      setCookieRoute (env ^. #cfg % #cookie) "/login" Map.empty+    Right authToken -> setCookieRoute (env ^. #cfg % #cookie) "/songs" (Map.fromList [(authCookieName, encodeToken authToken)])+  where+    email = T.unpack $ fromForm multipartData "" "email"+    password = T.unpack $ fromForm multipartData "" "password"++loginFormRoute :: (MonadIO m) => Env -> Maybe Text -> m Html+loginFormRoute env cookie = liftIO $ exec @View (loginPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette))+  where+    viewVars = viewVarsFromCookies cookie
+ src/WikiMusic/SSR/Servant/PreferenceRoutes.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedLabels #-}++module WikiMusic.SSR.Servant.PreferenceRoutes+  ( setLanguageRoute,+    setArtistSortingRoute,+    setGenreSortingRoute,+    setSongSortingRoute,+    setDarkModeRoute,+    setSongAsciiSizeRoute,+    setPaletteRoute,+  )+where++import Control.Monad.Error.Class+import Data.Map qualified as Map+import Optics+import Relude+import Servant+import Servant.Multipart+import WikiMusic.SSR.Backend.Rest ()+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env+import WikiMusic.SSR.Servant.Utilities+import WikiMusic.SSR.View.Html ()++setLanguageRoute :: (MonadError ServerError m) => Env -> Maybe Text -> MultipartData tag -> m a+setLanguageRoute env maybeReferer multipartData =+  setCookieRoute (env ^. #cfg % #cookie) (fromMaybe "/songs" maybeReferer) (Map.fromList [(localeCookieName, wantedLanguage)])+  where+    wantedLanguage = fromForm multipartData "en" "locale"++setArtistSortingRoute :: (MonadError ServerError m) => Env -> Maybe Text -> MultipartData tag -> m a+setArtistSortingRoute env maybeReferer multipartData =+  setCookieRoute (env ^. #cfg % #cookie) (fromMaybe "/artists" maybeReferer) (Map.fromList [(artistSortingCookieName, artistSorting)])+  where+    artistSorting = fromForm multipartData "created-at-desc" "artist-sorting"++setGenreSortingRoute :: (MonadError ServerError m) => Env -> Maybe Text -> MultipartData tag -> m a+setGenreSortingRoute env maybeReferer multipartData =+  setCookieRoute (env ^. #cfg % #cookie) (fromMaybe "/genres" maybeReferer) (Map.fromList [(genreSortingCookieName, genreSorting)])+  where+    genreSorting = fromForm multipartData "created-at-desc" "genre-sorting"++setSongSortingRoute :: (MonadError ServerError m) => Env -> Maybe Text -> MultipartData tag -> m a+setSongSortingRoute env maybeReferer multipartData =+  setCookieRoute (env ^. #cfg % #cookie) (fromMaybe "/songs" maybeReferer) (Map.fromList [(songSortingCookieName, songSorting)])+  where+    songSorting = fromForm multipartData "created-at-desc" "song-sorting"++setDarkModeRoute :: (MonadError ServerError m) => Env -> Maybe Text -> MultipartData tag -> m a+setDarkModeRoute env maybeReferer multipartData =+  setCookieRoute (env ^. #cfg % #cookie) (fromMaybe "/songs" maybeReferer) (Map.fromList [(uiModeCookieName, mode)])+  where+    mode = fromForm multipartData "dark" "dark-mode"++setSongAsciiSizeRoute :: (MonadError ServerError m) => Env -> Maybe Text -> MultipartData tag -> m a+setSongAsciiSizeRoute env maybeReferer multipartData =+  setCookieRoute (env ^. #cfg % #cookie) (fromMaybe "/songs" maybeReferer) (Map.fromList [(songAsciiSizeCookieName, songAsciiSize)])+  where+    songAsciiSize = fromForm multipartData "medium" "song-ascii-size"++setPaletteRoute :: (MonadError ServerError m) => Env -> Maybe Text -> MultipartData tag -> m a+setPaletteRoute env maybeReferer multipartData =+  setCookieRoute (env ^. #cfg % #cookie) (fromMaybe "/songs" maybeReferer) (Map.fromList [(paletteCookieName, palette')])+  where+    palette' = fromForm multipartData "mauve" "palette"
+ src/WikiMusic/SSR/Servant/SongRoutes.hs view
@@ -0,0 +1,73 @@+{-# LANGUAGE OverloadedLabels #-}++module WikiMusic.SSR.Servant.SongRoutes+  ( songsRoute,+    songRoute,+    songCreateRoute,+  )+where++import Data.UUID (UUID)+import Free.AlaCarte+import Optics+import Relude+import Text.Blaze.Html as Html+import WikiMusic.Model.Other+import WikiMusic.SSR.Backend.Rest ()+import WikiMusic.SSR.Free.Backend+import WikiMusic.SSR.Free.View+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env+import WikiMusic.SSR.Servant.Utilities+import WikiMusic.SSR.View.Html ()++songsRoute :: (MonadIO m) => Env -> Maybe Text -> Maybe Text -> Maybe Int -> Maybe Int -> m Html+songsRoute env cookie givenSortOrder limit offset = do+  maybeSongs <-+    liftIO+      $ exec @Backend+        ( getSongs+            env+            (viewVars ^. #authToken)+            (maybe (Limit 50) Limit limit)+            (maybe (Offset 0) Offset offset)+            sortOrder+            (Include {value = "artworks,comments,opinions"})+        )+  eitherView+    env+    (viewVars ^. #uiMode)+    (viewVars ^. #locale)+    (viewVars ^. #palette)+    maybeSongs+    (exec @View . songListPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette) sortOrder)+  where+    viewVars = viewVarsFromCookies cookie+    sortOrder = maybe (viewVars ^. #songSorting) SortOrder givenSortOrder++songRoute :: (MonadIO m) => Env -> Maybe Text -> UUID -> m Html+songRoute env cookie identifier = do+  maybeSongs <-+    liftIO+      $ exec @Backend+        ( getSong+            env+            (viewVars ^. #authToken)+            identifier+            (Include {value = "artworks,comments,opinions,contents"})+        )+  eitherView+    env+    (viewVars ^. #uiMode)+    (viewVars ^. #locale)+    (viewVars ^. #palette)+    maybeSongs+    (exec @View . songDetailPage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette) (viewVars ^. #songAsciiSize))+  where+    viewVars = viewVarsFromCookies cookie++songCreateRoute :: (MonadIO m) => Env -> Maybe Text -> m Html+songCreateRoute env cookie = do+  liftIO $ exec @View (songCreatePage env (viewVars ^. #uiMode) (viewVars ^. #locale) (viewVars ^. #palette))+  where+    viewVars = viewVarsFromCookies cookie
+ src/WikiMusic/SSR/Servant/Utilities.hs view
@@ -0,0 +1,123 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE QuasiQuotes #-}++module WikiMusic.SSR.Servant.Utilities+  ( fromForm,+    setCookieRoute,+    encodeToken,+    mkCookieData,+    mkCookieMap,+    decodeToken,+    eitherView,+    viewVarsFromCookies,+    maybeFromForm,+  )+where++import Control.Monad.Error.Class+import Data.ByteString.Base16.Lazy qualified as B16+import Data.Map qualified as Map+import Data.Text qualified as T+import Free.AlaCarte+import NeatInterpolation+import Optics+import Relude+import Servant+import Servant.Multipart+import Text.Blaze.Html+import WikiMusic.SSR.Backend.Rest ()+import WikiMusic.SSR.Free.View+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Config+import WikiMusic.SSR.Model.Env+import WikiMusic.SSR.View.Html ()++fromForm :: MultipartData tag -> Text -> Text -> Text+fromForm multipart fallback name =+  maybe fallback head+    . nonEmpty+    . map iValue+    . filter (\i -> iName i == name)+    $ inputs multipart++maybeFromForm :: MultipartData tag -> Text -> Maybe Text+maybeFromForm multipart name = case rawVal of+  (Just "") -> Nothing+  (Just x) -> Just x+  Nothing -> Nothing+  where+    rawVal =+      fmap head+        . nonEmpty+        . map iValue+        . filter (\i -> iName i == name)+        $ inputs multipart++setCookieRoute :: (MonadError ServerError m) => CookieConfig -> Text -> Map Text Text -> m a+setCookieRoute cookieConfig newLocation cookieMap =+  throwError+    $ ServerError+      { errHTTPCode = 302,+        errReasonPhrase = "Found",+        errBody = "",+        errHeaders =+          ("Location", encodeUtf8 newLocation) : cookieHeaders+      }+  where+    mkCookieHeaders (cookieName, cookieValue) =+      ( "Set-Cookie",+        fromString+          . T.unpack+          . mkCookieData cookieConfig+          $ [trimming|$cookieName=$cookieValue|]+      )+    cookieHeaders = map mkCookieHeaders (Map.assocs cookieMap)++mkCookieData :: CookieConfig -> Text -> Text+mkCookieData cookieConfig dyn = [trimming|$dyn; HttpOnly; $sameSite; Domain=$domain; Path=/; Max-Age=$maxAge $secureSuffix |]+  where+    maxAge = show $ cookieConfig ^. #maxAge+    domain = cookieConfig ^. #domain+    sameSite = cookieConfig ^. #sameSite+    secureSuffix = if cookieConfig ^. #secure then "; Secure" else ""++mkCookieMap :: Maybe Text -> Map Text Text+mkCookieMap cookie = do+  let diffCookies = maybe [] (T.splitOn "; ") cookie+      cookieParser [a, b] = Just (a, b)+      cookieParser _ = Nothing+      cookieMap = Map.fromList $ mapMaybe (cookieParser . T.splitOn "=") diffCookies+  cookieMap++eitherView :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> Either Text t -> (t -> IO Html) -> m Html+eitherView env mode language palette x eff = case x of+  Left e -> liftIO $ exec @View (errorPage env mode language palette e)+  Right r -> liftIO $ eff r++decodeToken :: Text -> Text+decodeToken = decodeUtf8 . B16.decodeLenient . encodeUtf8++encodeToken :: Text -> Text+encodeToken = decodeUtf8 . B16.encode . encodeUtf8++viewVarsFromCookies :: Maybe Text -> ViewVars+viewVarsFromCookies cookie = ViewVars {..}+  where+    cookieMap = mkCookieMap cookie+    locale = Language {value = fromMaybe "en" (cookieMap Map.!? localeCookieName)}+    uiMode = UiMode {value = fromMaybe "light" (cookieMap Map.!? uiModeCookieName)}+    authToken = AuthToken {value = decodeToken $ fromMaybe "" (cookieMap Map.!? authCookieName)}+    songAsciiSize = SongAsciiSize {value = fromMaybe "medium" (cookieMap Map.!? songAsciiSizeCookieName)}+    artistSorting =+      SortOrder+        { value = fromMaybe "created-at-desc" (cookieMap Map.!? artistSortingCookieName)+        }+    songSorting =+      SortOrder+        { value = fromMaybe "created-at-desc" (cookieMap Map.!? songSortingCookieName)+        }+    genreSorting =+      SortOrder+        { value = fromMaybe "created-at-desc" (cookieMap Map.!? genreSortingCookieName)+        }+    palette = Palette {value = fromMaybe "mauve" (cookieMap Map.!? paletteCookieName)}
+ src/WikiMusic/SSR/View/ArtistHtml.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.View.ArtistHtml+  ( artistListPage',+    artistDetailPage',+    artistCreatePage',+  )+where++import Data.Map qualified as Map+import Optics+import Relude+import Text.Blaze.Html+import Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes as A+import WikiMusic.Interaction.Model.Artist+import WikiMusic.SSR.Language+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env+import WikiMusic.SSR.View.Components.Forms+import WikiMusic.SSR.View.Components.Meta+import WikiMusic.SSR.View.Components.Other+import WikiMusic.SSR.View.Components.PageTop++artistListPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> SortOrder -> GetArtistsQueryResponse -> m Html+artistListPage' env mode language palette sortOrder xs = do+  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #artistsPage |##| language)+  pure $ H.html $ do+    sharedHead+    body $ section $ do+      sharedPageTop (Just $ dictionary ^. #titles % #artistsPage |##| language) mode language palette+      section ! class_ "flex direction-row justify-content-center gap-small align-items-baseline" $ do+        H.a ! href "/artists/create" $ button $ H.small "+ new artist"+        mkSortingForm language sortOrder "/user-preferences/artist-sorting" "artist-sorting"+      section ! class_ "entity-card-section" $ mapM_ (simpleEntityCard language "artists") sortedXs+  where+    sortedXs =+      mapMaybe+        (\identifier -> (xs ^. #artists) Map.!? identifier)+        (xs ^. #sortOrder)++artistDetailPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> Artist -> m Html+artistDetailPage' env mode language palette x = do+  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #artistsPage |##| language)+  pure $ H.html $ do+    sharedHead+    body $ section $ do+      sharedPageTop Nothing mode language palette+      entityDetails language "artists" x++artistCreatePage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> m Html+artistCreatePage' env mode language palette = do+  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #artistsPage |##| language)+  pure $ H.html $ do+    sharedHead+    body $ section $ do+      sharedPageTop Nothing mode language palette+      section $ do+        H.h2 "Create artist"+        postForm "/artists/create" $ do+          requiredTextInput "displayName" "artist name"+          optionalTextArea "description" "description"+          optionalTextInput "spotifyUrl" "spotify URL"+          optionalTextInput "youtubeUrl" "youtube URL"+          optionalTextInput "wikipediaUrl" "wikipedia URL"+          optionalTextInput "soundcloudUrl" "soundcloud URL"+          submitButton language
+ src/WikiMusic/SSR/View/Components/DetailList.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.View.Components.DetailList+  ( detailList,+    detailListEntry,+  )+where++import Relude+import Text.Blaze.Html+import Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes as A++detailListEntry :: Text -> Html -> Html+detailListEntry key val = do+  H.div ! class_ "flex direction-row gap-small align-items-baseline" $ do+    dt . small . text $ key+    dd . small $ val++detailList :: Html -> Html+detailList = dl ! class_ "margin-top-medium flex direction-column gap-small align-items-baseline"
+ src/WikiMusic/SSR/View/Components/Forms.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.View.Components.Forms+  ( mkSortingForm,+    requiredTextInput,+    formInput,+    optionalTextInput,+    requiredEmailInput,+    requiredPasswordInput,+    submitButton,+    postForm,+    postForm',+    formArea,+    optionalTextArea,+    requiredTextArea,+  )+where++import Data.Text qualified as T+import Optics+import Relude+import Text.Blaze.Html+import Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes as A+import WikiMusic.SSR.Language+import WikiMusic.SSR.Model.Api++mkSortingForm :: Language -> SortOrder -> Text -> Text -> Html+mkSortingForm language sortOrder action' fieldName = section+  $ H.form+  ! action (fromString . T.unpack $ action')+  ! method "POST"+  ! enctype "multipart/form-data"+  $ do+    select ! onchange "this.form.submit()" ! name (fromString . T.unpack $ fieldName) $ mapM_ mkOption entries+    noscript $ button ! type_ "submit" $ "submit"+  where+    mkOption :: (Text, Text) -> Html+    mkOption o =+      option+        !? (fst o == sortOrder ^. #value, selected "true")+        ! value (fromString . T.unpack $ fst o)+        $ text ("↕  " <> snd o)+    entries =+      [ ("display-name-asc", dictionary ^. #sortings % #alphabeticalAsc |##| language),+        ("display-name-desc", dictionary ^. #sortings % #alphabeticalDesc |##| language),+        ("created-at-asc", dictionary ^. #sortings % #createdAtAsc |##| language),+        ("created-at-desc", dictionary ^. #sortings % #createdAtDesc |##| language)+      ]++requiredTextInput :: Text -> Text -> Html+requiredTextInput name' displayLabel = formInput name' displayLabel True "text"++requiredTextArea :: Text -> Text -> Html+requiredTextArea name' displayLabel = formArea name' displayLabel True "text"++optionalTextInput :: Text -> Text -> Html+optionalTextInput name' displayLabel = formInput name' displayLabel False "text"++optionalTextArea :: Text -> Text -> Html+optionalTextArea name' displayLabel = formArea name' displayLabel False "text"++requiredEmailInput :: Text -> Text -> Html+requiredEmailInput name' displayLabel = formInput name' displayLabel True "email"++requiredPasswordInput :: Text -> Text -> Html+requiredPasswordInput name' displayLabel = formInput name' displayLabel True "password"++formInput :: Text -> Text -> Bool -> AttributeValue -> Html+formInput name' displayLabel isRequired type' = do+  H.div ! class_ "flex direction-column gap-medium margin-top-small" $ do+    H.div $ do+      H.label ! A.for name'' $ fromString . T.unpack $ displayLabel+      mapM_ (H.span ! class_ "color-error") (if isRequired then Just "*" else Nothing)+    H.input ! class_ "" !? (isRequired, required "") ! A.name name'' ! A.id name'' ! type_ type'+  where+    name'' = fromString . T.unpack $ name'++formArea :: Text -> Text -> Bool -> AttributeValue -> Html+formArea name' displayLabel isRequired type' = do+  H.div ! class_ "flex direction-column gap-medium margin-top-small" $ do+    H.div $ do+      H.label ! A.for name'' $ fromString . T.unpack $ displayLabel+      mapM_ (H.span ! class_ "color-error") (if isRequired then Just "*" else Nothing)+    H.textarea ! class_ "" !? (isRequired, required "") ! A.name name'' ! A.id name'' ! type_ type' $ ""+  where+    name'' = fromString . T.unpack $ name'++submitButton :: Language -> Html+submitButton language =+  button ! A.class_ "background-success border-success align-self-flex-end" ! type_ "submit" $ do+    H.span "✓"+    text $ dictionary ^. #forms % #submit |##| language++postForm :: Text -> Html -> Html+postForm action' =+  H.form+    ! class_ "margin-top-large flex direction-column align-items-flex-start"+    ! method "POST"+    ! action (fromString . T.unpack $ action')+    ! enctype "multipart/form-data"++postForm' :: Text -> Text -> Html -> Html+postForm' action' class' =+  H.form+    ! class_ (fromString . T.unpack $ class')+    ! method "POST"+    ! action (fromString . T.unpack $ action')+    ! enctype "multipart/form-data"
+ src/WikiMusic/SSR/View/Components/Meta.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.View.Components.Meta+  ( mkSharedHead,+  )+where++import Data.Text qualified as T+import Optics+import Relude+import Text.Blaze.Html+import Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes as A+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env++mkSharedHead :: (MonadIO m) => Env -> UiMode -> Palette -> Text -> m Html+mkSharedHead env mode palette pageTitle = do+  let style' = fromString . T.unpack $ (env ^. #mainCss)+  let modeStyle =+        if (mode ^. #value) == "dark"+          then env ^. #darkCss+          else env ^. #lightCss+  let paletteStyle = case palette ^. #value of+        "green" -> env ^. #palettes % #green+        _ -> env ^. #palettes % #mauve++  pure $ H.head $ do+    H.meta ! charset "utf-8"+    H.meta ! lang "en"+    H.title . fromString . T.unpack $ pageTitle+    meta ! name "viewport" ! content "width=device-width, initial-scale=1"+    H.style $ fromString . T.unpack $ modeStyle+    H.style $ fromString . T.unpack $ paletteStyle+    H.style style'
+ src/WikiMusic/SSR/View/Components/Other.hs view
@@ -0,0 +1,239 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.View.Components.Other+  ( likeCount,+    dislikeCount,+    simpleEntityCard,+    imageCarousel,+    warningBanner,+    entityDetails,+  )+where++import Data.Map qualified as Map+import Data.Text qualified as T+import Data.UUID (UUID)+import Optics+import Relude+import Text.Blaze.Html+import Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes as A+import WikiMusic.Model.Artwork+import WikiMusic.SSR.Language+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.View.Components.DetailList+import WikiMusic.SSR.View.Components.Forms++likeCount ::+  ( Is k1 A_Getter,+    Is k2 A_Getter,+    JoinKinds k3 l k2,+    LabelOptic "isLike" l u v Bool Bool,+    LabelOptic "opinions" k1 s1 s1 (Map k4 s2) (Map k4 s2),+    LabelOptic "opinion" k3 s2 s2 u v+  ) =>+  s1 ->+  Text+likeCount entity =+  T.pack+    . show+    . length+    $ Map.elems+    $ Map.filter (^. #opinion % #isLike) (entity ^. #opinions)++dislikeCount ::+  ( Is k1 A_Getter,+    Is k2 A_Getter,+    JoinKinds k3 l k2,+    LabelOptic "opinions" k1 s1 s1 (Map k4 s2) (Map k4 s2),+    LabelOptic "opinion" k3 s2 s2 u v,+    LabelOptic "isDislike" l u v Bool Bool+  ) =>+  s1 ->+  Text+dislikeCount entity =+  T.pack+    . show+    . length+    $ Map.elems+    $ Map.filter (^. #opinion % #isDislike) (entity ^. #opinions)++mkIdentifierHref :: Text -> UUID -> AttributeValue+mkIdentifierHref path identifier = fromString ("/" <> T.unpack path <> "/" <> show identifier)++simpleEntityCard ::+  ( Is k1 A_Getter,+    Is k3 A_Getter,+    Is k4 A_Getter,+    Is k5 A_Getter,+    Is k6 A_Getter,+    Is k7 A_Getter,+    Is k8 A_Getter,+    Is k9 A_Getter,+    Show a,+    JoinKinds k10 l1 k4,+    JoinKinds k10 l2 k3,+    LabelOptic "displayName" k8 s1 s1 Text Text,+    LabelOptic "isLike" l1 u v Bool Bool,+    LabelOptic "artworks" k5 s1 s1 (Map k11 s2) (Map k11 s2),+    LabelOptic "identifier" k7 s1 s1 UUID UUID,+    LabelOptic "opinions" k9 s1 s1 (Map k12 s3) (Map k12 s3),+    LabelOptic "viewCount" k1 s1 s1 a a,+    LabelOptic "artwork" k6 s2 s2 Artwork Artwork,+    LabelOptic "opinion" k10 s3 s3 u v,+    LabelOptic "isDislike" l2 u v Bool Bool+  ) =>+  Language ->+  Text ->+  s1 ->+  Html+simpleEntityCard language path entity = article ! class_ "simple-entity-card" $ do+  maybeImg+  a+    ! href (mkIdentifierHref path (entity ^. #identifier))+    ! class_ "margin-top-large"+    $ h3+    . text+    $ entity+    ^. #displayName+  detailList $ do+    detailListEntry (dictionary ^. #more % #likes |##| language) (text $ likeCount entity)+    detailListEntry (dictionary ^. #more % #dislikes |##| language) (text $ dislikeCount entity)+    detailListEntry (dictionary ^. #more % #views |##| language) (text $ T.pack . show $ entity ^. #viewCount)+  where+    artworks = Relude.map (\x -> x ^. #artwork) (Map.elems $ entity ^. #artworks) :: [Artwork]+    maybeImg = maybe (H.span "") (toImg . Relude.head) (nonEmpty artworks)+    toImg x =+      a+        ! href (mkIdentifierHref path (entity ^. #identifier))+        $ img+        ! customAttribute "loading" "lazy"+        ! src (fromString . T.unpack $ x ^. #contentUrl)++imageCarousel :: [Artwork] -> Html+imageCarousel artworks = do+  section ! class_ "slider" $ do+    mapM_+      ( \x ->+          img+            ! customAttribute "loading" "lazy"+            ! src (fromString . T.unpack $ x ^. #contentUrl)+      )+      artworks++entityDetailsSkeleton :: Html -> Html -> Html+entityDetailsSkeleton slot0 slot1 = do+  H.div ! class_ "flex direction-row justify-content-space-evenly" $ do+    H.div ! class_ "col" $ do+      slot0+    H.div ! class_ "col" $ do+      slot1++entityDetails ::+  ( Is k1 A_Getter,+    Is k2 A_Getter,+    Is k3 A_Getter,+    Is k4 A_Getter,+    Is k5 A_Getter,+    Is k6 A_Getter,+    Is k7 A_Getter,+    Is k8 A_Getter,+    Is k9 A_Getter,+    Is k10 A_Getter,+    Is k11 A_Getter,+    Is k12 A_Getter,+    Is k13 A_Getter,+    Foldable t1,+    Foldable t2,+    Foldable t3,+    Foldable t4,+    Foldable t5,+    Foldable t6,+    Show a1,+    Show a2,+    Show a3,+    Show a4,+    Show a5,+    Functor t4,+    LabelOptic "createdAt" k4 s s a2 a2,+    LabelOptic "createdBy" k3 s s a1 a1,+    LabelOptic "lastEditedAt" k11 s s (t4 a5) (t4 a5),+    LabelOptic "displayName" k5 s s Text Text,+    LabelOptic "artworks" k6 s s (Map k14 a6) (Map k14 a6),+    LabelOptic "identifier" k9 s s a3 a3,+    LabelOptic "viewCount" k10 s s a4 a4,+    LabelOptic "artwork" k7 a6 a6 Artwork Artwork,+    LabelOptic "description" k8 s s (t3 Text) (t3 Text),+    LabelOptic "soundcloudUrl" k1 s s (t1 Text) (t1 Text),+    LabelOptic "spotifyUrl" k12 s s (t5 Text) (t5 Text),+    LabelOptic "wikipediaUrl" k2 s s (t2 Text) (t2 Text),+    LabelOptic "youtubeUrl" k13 s s (t6 Text) (t6 Text)+  ) =>+  Language ->+  Text ->+  s ->+  Html+entityDetails language path x = do+  entityDetailsSkeleton slot0 slot1+  where+    verboseLink' uri = a ! href (fromString . T.unpack $ uri) $ text uri+    path' = T.unpack path+    entityLinks = do+      mapM_+        (detailListEntry "Spotify" . verboseLink')+        (x ^. #spotifyUrl)+      mapM_+        (detailListEntry "Wikipedia" . verboseLink')+        (x ^. #wikipediaUrl)+      mapM_+        (detailListEntry "YouTube" . verboseLink')+        (x ^. #youtubeUrl)+      mapM_+        (detailListEntry "SoundCloud" . verboseLink')+        (x ^. #soundcloudUrl)+    slot0 = do+      imageCarousel (Relude.map (^. #artwork) (Map.elems $ x ^. #artworks))+      H.div ! class_ "" $ do+        a+          ! href (fromString ("/" <> path' <> "/edit/" <> show (x ^. #identifier)))+          $ button+          $ text (dictionary ^. #buttons % #edit |##| language)+        a+          ! href (fromString ("/" <> path' <> "/delete/" <> show (x ^. #identifier)))+          $ button+          $ text (dictionary ^. #buttons % #delete |##| language)+      mapM_ (p . text) (x ^. #description)++    slot1 = do+      (h3 ! class_ "text-align-center font-size-xxx-large font-weight-500") . fromString . T.unpack $ (x ^. #displayName)+      H.div ! class_ "flex direction-column" $ do+        section ! class_ "flex direction-row justify-content-center gap-small align-items-baseline" $ do+          postForm' (fromString ("/" <> path' <> "/like/" <> show (x ^. #identifier))) "" $ do+            button ! type_ "submit" $ do+              H.span "+"+              text (dictionary ^. #buttons % #like |##| language)+          postForm' (fromString ("/" <> path' <> "/dislike/" <> show (x ^. #identifier))) "" $ do+            button ! type_ "submit" $ do+              H.span "-"+              text (dictionary ^. #buttons % #dislike |##| language)++        section $ detailList $ do+          detailListEntry (dictionary ^. #more % #views |##| language) (Relude.show $ x ^. #viewCount)+          detailListEntry (dictionary ^. #more % #createdAt |##| language) (Relude.show $ x ^. #createdAt)+          mapM_+            (detailListEntry (dictionary ^. #more % #lastEditedAt |##| language))+            (Relude.show <$> x ^. #lastEditedAt)+          detailListEntry (dictionary ^. #more % #createdBy |##| language) (Relude.show $ x ^. #createdBy)++          hr+          entityLinks++warningBanner :: Language -> Html+warningBanner language =+  section ! class_ "warning-section text-align-center" $ do+    small+      ! class_ "warning-text"+      $ text+        (dictionary ^. #more % #warningHeavyDevelopment |##| language)
+ src/WikiMusic/SSR/View/Components/PageTop.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.View.Components.PageTop+  ( sharedPageTop,+  )+where++import Data.Text qualified as T+import Optics+import Relude+import Text.Blaze.Html+import Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes as A+import WikiMusic.SSR.Language+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.View.Components.Other++sharedPageTop :: Maybe Text -> UiMode -> Language -> Palette -> Html+sharedPageTop title' mode language palette = do+  section ! class_ "flex direction-column flex items-center" $ do+    a+      ! href "/songs"+      $ h1+      ! class_ "italic font-size-xxx-large font-weight-300"+      $ text (dictionary ^. #titles % #wikimusicSSR |##| language)+    em+      ! class_ "margin-top-large font-size-large font-weight-300"+      $ text (dictionary ^. #slogans % #pageTop |##| language)++  section ! class_ "flex direction-row justify-content-center gap-small" $ do+    H.div+      $ H.form+      ! action "/user-preferences/locale"+      ! method "POST"+      ! enctype "multipart/form-data"+      $ do+        select ! onchange "this.form.submit()" ! name "locale" $ do+          option !? ((language ^. #value) == "en", selected "true") ! value "en" $ "🇬🇧 English"+          option !? ((language ^. #value) == "nl", selected "true") ! value "nl" $ "🇳🇱 Nederlands"++        noscript $ button ! type_ "submit" $ "submit"+    H.div $ H.form ! action "/user-preferences/dark-mode" ! method "POST" ! enctype "multipart/form-data" $ do+      select ! onchange "this.form.submit()" ! type_ "checkbox" ! name "dark-mode" ! A.id "dark-mode" $ do+        option !? ((mode ^. #value) == "dark", selected "true") ! value "dark" $ "☾  dark mode"+        option !? ((mode ^. #value) == "light", selected "true") ! value "light" $ "☼  light mode"+      noscript $ button ! type_ "submit" $ "submit"+    H.div $ H.form ! action "/user-preferences/palette" ! method "POST" ! enctype "multipart/form-data" $ do+      select ! onchange "this.form.submit()" ! type_ "checkbox" ! name "palette" ! A.id "palette" $ do+        option !? ((palette ^. #value) == "mauve", selected "true") ! value "mauve" $ "mauve"+        option !? ((palette ^. #value) == "green", selected "true") ! value "green" $ "green"+      noscript $ button ! type_ "submit" $ "submit"++  warningBanner language+  myNav language+  mapM_ (\x -> H.div ! class_ "text-align-center" $ (h2 ! class_ "font-weight-300 font-size-xx-large") . fromString . T.unpack $ x) title'++myNav :: Language -> Html+myNav language = do+  hr+  nav $ ol $ do+    li $ a ! class_ "nav-link scale-on-hover" ! href "/songs" $ text (dictionary ^. #more % #songsNav |##| language)+    li $ a ! class_ "nav-link scale-on-hover" ! href "/artists" $ text (dictionary ^. #more % #artistsNav |##| language)+    li $ a ! class_ "nav-link scale-on-hover" ! href "/genres" $ text (dictionary ^. #more % #genresNav |##| language)+    li $ a ! class_ "nav-link scale-on-hover" ! href "/login" $ text (dictionary ^. #more % #loginNav |##| language)+  hr
+ src/WikiMusic/SSR/View/GenreHtml.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.View.GenreHtml+  ( genreListPage',+    genreDetailPage',+    genreCreatePage',+  )+where++import Data.Map qualified as Map+import Optics+import Relude+import Text.Blaze.Html+import Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes as A+import WikiMusic.Interaction.Model.Genre+import WikiMusic.SSR.Language+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env+import WikiMusic.SSR.View.Components.Forms+import WikiMusic.SSR.View.Components.Meta+import WikiMusic.SSR.View.Components.Other+import WikiMusic.SSR.View.Components.PageTop++genreListPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> SortOrder -> GetGenresQueryResponse -> m Html+genreListPage' env mode language palette sortOrder xs = do+  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #genresPage |##| language)+  pure $ H.html $ do+    sharedHead+    body $ section $ do+      sharedPageTop (Just $ dictionary ^. #titles % #genresPage |##| language) mode language palette+      section ! class_ "flex direction-row justify-content-center gap-small align-items-baseline" $ do+        H.a ! href "/genres/create" $ button $ H.small "+ new genre"+        mkSortingForm language sortOrder "/user-preferences/genre-sorting" "genre-sorting"+      section ! class_ "entity-card-section" $ mapM_ (simpleEntityCard language "genres") sortedXs+  where+    sortedXs =+      mapMaybe+        (\identifier -> (xs ^. #genres) Map.!? identifier)+        (xs ^. #sortOrder)++genreDetailPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> Genre -> m Html+genreDetailPage' env mode language palette x = do+  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #genresPage |##| language)+  pure $ H.html $ do+    sharedHead+    body $ section $ do+      sharedPageTop Nothing mode language palette+      entityDetails language "genres" x++genreCreatePage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> m Html+genreCreatePage' env mode language palette = do+  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #genresPage |##| language)+  pure $ H.html $ do+    sharedHead+    body $ section $ do+      sharedPageTop Nothing mode language palette+      section $ do+        H.h2 "Create genre"+        postForm "/genres/create" $ do+          requiredTextInput "displayName" "genre name"+          optionalTextArea "description" "description"+          optionalTextInput "spotifyUrl" "spotify URL"+          optionalTextInput "youtubeUrl" "youtube URL"+          optionalTextInput "wikipediaUrl" "wikipedia URL"+          optionalTextInput "soundcloudUrl" "soundcloud URL"+          submitButton language
+ src/WikiMusic/SSR/View/Html.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.View.Html () where++import Data.Map qualified as Map+import Data.Text qualified as T+import Free.AlaCarte+import Optics+import Relude+import Text.Blaze.Html+import Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes as A+import WikiMusic.SSR.Free.View+import WikiMusic.SSR.Language+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env+import WikiMusic.SSR.View.ArtistHtml+import WikiMusic.SSR.View.Components.Forms+import WikiMusic.SSR.View.Components.Meta+import WikiMusic.SSR.View.Components.PageTop+import WikiMusic.SSR.View.GenreHtml+import WikiMusic.SSR.View.SongHtml+import Prelude qualified++instance Exec View where+  execAlgebra (ArtistListPage env mode sortOrder l palette r next) =+    next =<< artistListPage' env mode sortOrder l palette r+  execAlgebra (ArtistDetailPage env mode language palette r next) =+    next =<< artistDetailPage' env mode language palette (Prelude.head . Map.elems $ r ^. #artists)+  execAlgebra (ArtistCreatePage env mode language palette next) =+    next =<< artistCreatePage' env mode language palette+  execAlgebra (GenreListPage env mode sortOrder l palette r next) =+    next =<< genreListPage' env mode sortOrder l palette r+  execAlgebra (GenreDetailPage env mode language palette r next) =+    next =<< genreDetailPage' env mode language palette (Prelude.head . Map.elems $ r ^. #genres)+  execAlgebra (GenreCreatePage env mode language palette next) =+    next =<< genreCreatePage' env mode language palette+  execAlgebra (SongListPage env mode sortOrder language palette r next) =+    next =<< songListPage' env mode sortOrder language palette r+  execAlgebra (SongDetailPage env mode language palette songAsciiSize r next) =+    next =<< songDetailPage' env mode language palette songAsciiSize (Prelude.head . Map.elems $ r ^. #songs)+  execAlgebra (SongCreatePage env mode language palette next) =+    next =<< songCreatePage' env mode language palette+  execAlgebra (ErrorPage env mode language palette message next) =+    next =<< errorPage' env mode language palette message+  execAlgebra (LoginPage env mode language palette next) =+    next =<< loginPage' env mode language palette++errorPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> Text -> m Html+errorPage' env mode language palette message = do+  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #errorOccurred |##| language)+  pure $ H.html $ do+    sharedHead+    body $ section $ do+      sharedPageTop (Just $ dictionary ^. #titles % #errorOccurred |##| language) mode language palette+      h3 . text $ messageCauses+      H.pre ! class_ "font-size-small" $ text message+  where+    messageCauses :: Text+    messageCauses = T.intercalate " - " causeStrings+    causeStrings = catMaybes [Just "Error", if T.isInfixOf "504" message then Just "Gateway Timeout" else Nothing]++loginPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> m Html+loginPage' env mode language palette = do+  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #login |##| language)+  pure $ H.html $ do+    sharedHead+    body $ section $ do+      sharedPageTop (Just $ dictionary ^. #titles % #login |##| language) mode language palette+      section $ postForm "/login" $ do+        requiredEmailInput "email" (dictionary ^. #forms % #email |##| language)+        requiredPasswordInput "password" (dictionary ^. #forms % #password |##| language)+        submitButton language
+ src/WikiMusic/SSR/View/SongHtml.hs view
@@ -0,0 +1,136 @@+{-# LANGUAGE OverloadedLabels #-}+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}++module WikiMusic.SSR.View.SongHtml+  ( songListPage',+    songDetailPage',+    songCreatePage',+  )+where++import Data.Map qualified as Map+import Data.Text qualified as T+import Optics+import Relude+import Text.Blaze.Html+import Text.Blaze.Html5 as H+import Text.Blaze.Html5.Attributes as A+import WikiMusic.Interaction.Model.Song+import WikiMusic.Model.Song+import WikiMusic.SSR.Language+import WikiMusic.SSR.Model.Api+import WikiMusic.SSR.Model.Env+import WikiMusic.SSR.View.Components.DetailList+import WikiMusic.SSR.View.Components.Forms+import WikiMusic.SSR.View.Components.Meta+import WikiMusic.SSR.View.Components.Other+import WikiMusic.SSR.View.Components.PageTop++songListPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> SortOrder -> GetSongsQueryResponse -> m Html+songListPage' env mode language palette sortOrder xs = do+  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #songsPage |##| language)+  pure $ H.html $ do+    sharedHead+    body $ section $ do+      sharedPageTop (Just $ dictionary ^. #titles % #songsPage |##| language) mode language palette+      section ! class_ "flex direction-row justify-content-center gap-small align-items-baseline" $ do+        H.a ! href "/songs/create" $ button $ H.small "+ new song"+        mkSortingForm language sortOrder "/user-preferences/song-sorting" "song-sorting"+      section ! class_ "entity-card-section" $ mapM_ (simpleEntityCard language "songs") sortedXs+  where+    sortedXs =+      mapMaybe+        (\identifier -> (xs ^. #songs) Map.!? identifier)+        (xs ^. #sortOrder)++songDetailPage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> SongAsciiSize -> Song -> m Html+songDetailPage' env mode language palette songAsciiSize x = do+  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #songsPage |##| language)+  pure $ H.html $ do+    sharedHead+    body $ section $ do+      sharedPageTop Nothing mode language palette+      entityDetails language "songs" x+      songDetails language x+      H.div $ H.form ! action "/user-preferences/song-ascii-size" ! method "POST" ! enctype "multipart/form-data" $ do+        select ! onchange "this.form.submit()" ! type_ "checkbox" ! name "song-ascii-size" ! A.id "song-ascii-size" $ do+          mapM_+            ( \size' ->+                let mkOption = option !? ((songAsciiSize ^. #value) == size', selected "true") ! value (fromString . T.unpack $ size')+                 in mkOption . text $ size'+            )+            fontSizes+        noscript $ button ! type_ "submit" $ "submit"+      section $ do+        mapM_ (mkVersion language songAsciiSize) (x ^. #contents)+  where+    fontSizes :: [Text]+    fontSizes = ["xx-small", "x-small", "small", "medium", "large", "larger", "x-large", "xx-large"]++songDetails :: Language -> Song -> Html+songDetails language x = do+  section $ detailList $ do+    mapM_+      (detailListEntry (dictionary ^. #more % #musicTuning |##| language) . text)+      (x ^. #musicTuning)+    mapM_+      (detailListEntry (dictionary ^. #more % #musicKey |##| language) . text)+      (x ^. #musicKey)+    mapM_+      (detailListEntry (dictionary ^. #more % #musicCreationDate |##| language) . text)+      (x ^. #musicCreationDate)+    mapM_+      (detailListEntry (dictionary ^. #more % #albumName |##| language) . text)+      (x ^. #albumName)+    mapM_+      (detailListEntry (dictionary ^. #more % #albumInfoLink |##| language) . text)+      (x ^. #albumInfoLink)++mkVersion :: Language -> SongAsciiSize -> SongContent -> Html+mkVersion language songAsciiSize v = H.article $ do+  hr ! class_ "margin-top-medium"+  h3 . text $ (v ^. #versionName) <> " " <> (v ^. #instrumentType)++  detailList $ do+    mapM_+      (detailListEntry (dictionary ^. #more % #lastEditedAt |##| language))+      (Relude.show <$> v ^. #lastEditedAt)+    detailListEntry (dictionary ^. #more % #createdAt |##| language) (Relude.show $ v ^. #createdAt)+    detailListEntry (dictionary ^. #more % #createdBy |##| language) (Relude.show $ v ^. #createdBy)++  mapM_+    ( \asciiLegend -> details ! open "" $ do+        H.summary "ASCII Legend"+        (H.pre ! class_ (fromString . T.unpack $ "font-size-" <> (songAsciiSize ^. #value))) . text $ asciiLegend+    )+    (v ^. #asciiLegend)+  mapM_+    ( \asciiContents -> details ! open "" $ do+        H.summary "ASCII Content"+        (H.pre ! class_ (fromString . T.unpack $ "font-size-" <> (songAsciiSize ^. #value))) . text $ asciiContents+    )+    (v ^. #asciiContents)++songCreatePage' :: (MonadIO m) => Env -> UiMode -> Language -> Palette -> m Html+songCreatePage' env mode language palette = do+  sharedHead <- mkSharedHead env mode palette (dictionary ^. #titles % #songsPage |##| language)+  pure $ H.html $ do+    sharedHead+    body $ section $ do+      sharedPageTop Nothing mode language palette+      section $ do+        H.h2 "Create song"+        postForm "/songs/create" $ do+          requiredTextInput "displayName" "song name"+          optionalTextArea "description" "description"+          optionalTextInput "spotifyUrl" "spotify URL"+          optionalTextInput "youtubeUrl" "youtube URL"+          optionalTextInput "wikipediaUrl" "wikipedia URL"+          optionalTextInput "soundcloudUrl" "soundcloud URL"+          optionalTextInput "musicKey" "music key"+          optionalTextInput "musicTuning" "tuning"+          optionalTextInput "musicCreationDate" "date composed"+          optionalTextInput "albumName" "album name"+          optionalTextInput "albumInfoLink" "about the album"+          submitButton language
+ wikimusic-ssr.cabal view
@@ -0,0 +1,158 @@+cabal-version: 1.12++name:           wikimusic-ssr+version:        0.6.0.0+description:    Please see the README at <https://gitlab.com/jjba-projects/wikimusic-ssr>+homepage:       https://gitlab.com/jjba-projects/wikimusic-ssr+bug-reports:    https://gitlab.com/jjba-projects/wikimusic-ssr/-/issues+author:         Josep Bigorra+maintainer:     Josep Bigorra <jjbigorra@gmail.com>+copyright:      2023 Josep Bigorra+license:        GPL-3+build-type:     Simple+                +extra-source-files:+    README.org+    CHANGELOG.org++source-repository head+  type: git+  location: https://gitlab.com/jjba-projects/wikimusic-ssr+  subdir: wikimusic-ssr++library+  exposed-modules:+      -- λ main+      WikiMusic.SSR.Config+      WikiMusic.SSR.Boot+      WikiMusic.SSR.Prelude+      WikiMusic.SSR.Clock.LiveClock+      WikiMusic.SSR.Console.Logger+      WikiMusic.SSR.Model.Config+      WikiMusic.SSR.Model.Env+      WikiMusic.SSR.Model.Api+      WikiMusic.SSR.View.Components.PageTop+      WikiMusic.SSR.Free.Clock+      WikiMusic.SSR.Free.Logger+      WikiMusic.SSR.Free.View+      WikiMusic.SSR.Free.Backend+      WikiMusic.SSR.View.Html+      WikiMusic.SSR.View.ArtistHtml+      WikiMusic.SSR.View.GenreHtml+      WikiMusic.SSR.View.SongHtml+      WikiMusic.SSR.View.Components.Forms+      WikiMusic.SSR.View.Components.Other+      WikiMusic.SSR.View.Components.Meta+      WikiMusic.SSR.View.Components.DetailList+      WikiMusic.SSR.Backend.Rest+      WikiMusic.SSR.Language+      WikiMusic.SSR.Servant.ApiSetup+      WikiMusic.SSR.Servant.ApiSpec+      WikiMusic.SSR.Servant.Utilities+      WikiMusic.SSR.Servant.PreferenceRoutes+      WikiMusic.SSR.Servant.LoginRoutes+      WikiMusic.SSR.Servant.ArtistRoutes+      WikiMusic.SSR.Servant.GenreRoutes+      WikiMusic.SSR.Servant.SongRoutes++  other-modules:+      Paths_wikimusic_ssr+  hs-source-dirs:+      src+  ghc-options: -Wall -threaded+  default-extensions:+      DataKinds+      DefaultSignatures+      DuplicateRecordFields+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      InstanceSigs+      KindSignatures+      LambdaCase+      MultiWayIf+      NamedFieldPuns+      NoImplicitPrelude+      OverloadedStrings+      PartialTypeSignatures+      RecordWildCards+      TypeFamilies+      ViewPatterns++  build-depends:+      aeson+    , async+    , base < 5+    , bytestring+    , keuringsdienst+    , keys+    , mtl+    , optics+    , optparse-applicative+    , relude+    , time+    , servant+    , servant-blaze+    , servant-server+    , servant-auth-server+    , servant-multipart+    , servant-client+    , text+    , containers+    , filepath+    , directory+    , uuid+    , wai+    , wai-cors+    , wai-extra+    , warp+    , base64-bytestring+    , neat-interpolation+    , HTTP+    , free-alacarte+    , tomland+    , blaze-html+    , wikimusic-model-hs+    , wikimusic-api-spec+    , http-client+    , http-client-tls+    , base16-bytestring+  default-language: GHC2021++executable wikimusic-ssr-exe+  main-is: Main.hs+  other-modules:+      Paths_wikimusic_ssr+  hs-source-dirs:+      app+  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+  default-extensions:+      DataKinds+      DefaultSignatures+      DuplicateRecordFields+      EmptyDataDecls+      ExistentialQuantification+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      InstanceSigs+      KindSignatures+      LambdaCase+      MultiWayIf+      NamedFieldPuns+      NoImplicitPrelude+      OverloadedStrings+      PartialTypeSignatures+      RecordWildCards+      TypeFamilies+      ViewPatterns++  build-depends:+    base+    , relude+    , wikimusic-ssr+  default-language: GHC2021