Compare commits
No commits in common. "26af45713c5112fab46b31555cf635f0707ffb4b" and "7928aa1cb62ca568ceae885731224fa90614c314" have entirely different histories.
26af45713c
...
7928aa1cb6
16
.travis.yml
16
.travis.yml
@ -1,16 +0,0 @@
|
||||
language: nix
|
||||
|
||||
os:
|
||||
- linux
|
||||
|
||||
before_script:
|
||||
- mkdir -m 0755 -p /nix/var/nix/{profiles,gcroots}/per-user/$USER
|
||||
- mkdir -p ~/.config/nixpkgs
|
||||
|
||||
script:
|
||||
- nix build -f release.nix backend
|
||||
|
||||
|
||||
cache:
|
||||
directories:
|
||||
- nix
|
@ -68,7 +68,6 @@ executable backend
|
||||
, servant
|
||||
, servant-auth
|
||||
, servant-auth-server
|
||||
, servant-auth-docs
|
||||
, servant-docs
|
||||
, servant-lucid
|
||||
, servant-multipart
|
||||
@ -125,7 +124,6 @@ test-suite spec
|
||||
, servant-auth
|
||||
, servant-auth-server
|
||||
, servant-docs
|
||||
, servant-auth-docs
|
||||
, servant-lucid
|
||||
, servant-multipart
|
||||
, servant-server
|
||||
|
@ -25,14 +25,16 @@ import qualified API.Catalogue as Catalogue
|
||||
|
||||
data Index = Index
|
||||
|
||||
type API = Users.API
|
||||
type API = Get '[HTML] (AppView Index)
|
||||
:<|> Users.API
|
||||
:<|> "api" :> "current" :> Channels.API
|
||||
:<|> "api" :> "current" :> Books.API
|
||||
:<|> "api" :> "1" :> Catalogue.VersionedAPI 1
|
||||
:<|> "api" :> "current" :> Catalogue.VersionedAPI 1
|
||||
|
||||
handler :: ServerT API AppM
|
||||
handler = Users.handler
|
||||
handler = indexHandler
|
||||
:<|> Users.handler
|
||||
:<|> Channels.handler
|
||||
:<|> Books.handler
|
||||
:<|> Catalogue.handler
|
||||
|
@ -1,39 +1,40 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# Language DuplicateRecordFields #-}
|
||||
{-# Language DataKinds #-}
|
||||
{-# Language TypeFamilies #-}
|
||||
{-# Language TypeOperators #-}
|
||||
{-# Language NoImplicitPrelude #-}
|
||||
{-# Language MultiParamTypeClasses #-}
|
||||
{-# Language OverloadedStrings #-}
|
||||
{-# Language TemplateHaskell #-}
|
||||
{-# Language QuasiQuotes #-}
|
||||
{-# Language RecordWildCards #-}
|
||||
{-# Language DeriveGeneric #-}
|
||||
{-# Language FlexibleInstances #-}
|
||||
{-# Language TypeApplications #-}
|
||||
{-# Language DataKinds #-}
|
||||
{-# Language NamedFieldPuns #-}
|
||||
module API.Books where
|
||||
|
||||
import ClassyPrelude
|
||||
import Control.Lens
|
||||
import Control.Monad.Catch (MonadThrow, throwM)
|
||||
import Control.Monad.Trans.Maybe
|
||||
import Crypto.Hash (digestFromByteString)
|
||||
import Control.Monad.Catch (throwM, MonadThrow)
|
||||
import Data.Aeson
|
||||
import Data.ByteArray (convert)
|
||||
import Data.Generics.Product
|
||||
import Database
|
||||
import Database.Book
|
||||
import Database.Channel
|
||||
import Database.Tag
|
||||
import qualified Datastore as DS
|
||||
import Servant hiding (contentType)
|
||||
import Servant.Auth as SA
|
||||
import qualified Servant.Docs as Docs
|
||||
import Server.Auth
|
||||
import Types
|
||||
|
||||
import Control.Monad.Trans.Maybe
|
||||
|
||||
import qualified Datastore as DS
|
||||
import Data.ByteArray (convert)
|
||||
import Crypto.Hash (digestFromByteString)
|
||||
|
||||
data JsonBook = JsonBook { identifier :: BookID
|
||||
, contentType :: Text
|
||||
, title :: Text
|
||||
@ -42,12 +43,6 @@ data JsonBook = JsonBook { identifier :: BookID
|
||||
, tags :: [Text] }
|
||||
deriving (Generic, Show, Eq)
|
||||
|
||||
instance Docs.ToSample JsonBook where
|
||||
toSamples _ = [("Book", JsonBook 13 "epub" "title" (Just "Description") [] [])]
|
||||
|
||||
instance Docs.ToSample PostBook where
|
||||
toSamples _ = [("Book", PostBook "epub" "title" (Just "Description") [] [])]
|
||||
|
||||
data PostBook = PostBook { contentType :: Text
|
||||
, title :: Text
|
||||
, description :: Maybe Text
|
||||
@ -63,21 +58,13 @@ instance FromJSON PostBook
|
||||
|
||||
type API = Auth '[SA.BasicAuth, SA.JWT] SafeUser :> BaseAPI
|
||||
|
||||
instance Docs.ToCapture (Capture "book_id" BookID) where
|
||||
toCapture _ = Docs.DocCapture "book_id" "The book id"
|
||||
|
||||
type BaseAPI = "books" :> Get '[JSON] [JsonBook]
|
||||
:<|> "books" :> ReqBody '[JSON] PostBook :> Post '[JSON] JsonBook
|
||||
:<|> "books" :> Capture "book_id" BookID :> "meta" :> ReqBody '[JSON] JsonBook :> Put '[JSON] JsonBook
|
||||
:<|> "books" :> Capture "book_id" BookID :> ReqBody '[OctetStream] FileContent :> Put '[JSON] NoContent
|
||||
:<|> "books" :> Capture "book_id" BookID :> ReqBody '[OctetStream] ByteString :> Put '[JSON] NoContent
|
||||
:<|> GetBook
|
||||
|
||||
newtype FileContent = FileContent { getFileContent :: ByteString } deriving (MimeUnrender OctetStream, MimeRender OctetStream )
|
||||
|
||||
instance Docs.ToSample FileContent where
|
||||
toSamples _ = [("File contents", FileContent "bytes here and there")]
|
||||
|
||||
type GetBook = "books" :> Capture "book_id" BookID :> Get '[OctetStream] FileContent
|
||||
type GetBook = "books" :> Capture "book_id" BookID :> Get '[OctetStream] ByteString
|
||||
|
||||
handler :: ServerT API AppM
|
||||
handler user = listBooksHandler user
|
||||
@ -86,12 +73,12 @@ handler user = listBooksHandler user
|
||||
:<|> putBookContentHandler user
|
||||
:<|> getBookContentHandler user
|
||||
|
||||
getBookContentHandler :: AuthResult SafeUser -> BookID -> AppM FileContent
|
||||
getBookContentHandler :: AuthResult SafeUser -> BookID -> AppM ByteString
|
||||
getBookContentHandler auth bookId = requireBookOwner auth bookId $ \SafeUser{username} -> do
|
||||
content <- runMaybeT $ do
|
||||
Book{contentHash=mHash} <- MaybeT $ runDB (getBook bookId username)
|
||||
contentHash <- MaybeT $ return (mHash >>= digestFromByteString . unHex)
|
||||
FileContent <$> MaybeT (DS.get contentHash)
|
||||
MaybeT $ DS.get contentHash
|
||||
maybe (throwM err404) return content
|
||||
|
||||
requireBookOwner :: AuthResult SafeUser -> BookID -> (SafeUser -> AppM a) -> AppM a
|
||||
@ -100,9 +87,8 @@ requireBookOwner auth bookId f = flip requireLoggedIn auth $ \u@SafeUser{usernam
|
||||
unless exists $ throwM err404
|
||||
runDB (isBookOwner bookId username) >>= \o -> if o then f u else throwM err403
|
||||
|
||||
putBookContentHandler :: AuthResult SafeUser -> BookID -> FileContent -> AppM NoContent
|
||||
putBookContentHandler auth bookId fc = requireBookOwner auth bookId $ \SafeUser{username} -> do
|
||||
let content = getFileContent fc
|
||||
putBookContentHandler :: AuthResult SafeUser -> BookID -> ByteString -> AppM NoContent
|
||||
putBookContentHandler auth bookId content = requireBookOwner auth bookId $ \SafeUser{username} -> do
|
||||
key <- HashDigest . convert <$> DS.put content
|
||||
runDB (setContent bookId username key)
|
||||
return NoContent
|
||||
|
@ -24,10 +24,8 @@ import qualified Database.Channel as Channel
|
||||
import GHC.TypeLits
|
||||
import Servant hiding (contentType)
|
||||
import Servant.Auth as SA
|
||||
import qualified Servant.Docs as Docs
|
||||
import Servant.XML
|
||||
import Server.Auth
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
import Types
|
||||
|
||||
-- This is my first try on going to versioned apis, things might change
|
||||
@ -42,7 +40,7 @@ newtype Rel = Rel { unRel :: Text } deriving (IsString, Show)
|
||||
|
||||
data Pagination = Pagination { previous :: Maybe Rel
|
||||
, next :: Maybe Rel }
|
||||
deriving (Show, Generic)
|
||||
deriving (Show)
|
||||
|
||||
newtype SubSection = SubSection Rel deriving (Show)
|
||||
newtype Acquisition = Acquisition Rel deriving (Show)
|
||||
@ -66,20 +64,6 @@ deriving instance Show (Entry 1)
|
||||
deriving instance Generic (Catalog 1)
|
||||
deriving instance Generic (Entry 1)
|
||||
|
||||
instance Docs.ToSample (Entry 1) where
|
||||
toSamples _ = [("Entry", EntryV1 "title" "identifier" docsTime "content" (Left (SubSection (Rel "sub"))))]
|
||||
instance Docs.ToSample UTCTime where
|
||||
toSamples _ = [("time", docsTime)]
|
||||
instance Docs.ToSample Rel where
|
||||
toSamples _ = [("Relative link", Rel "next")]
|
||||
instance Docs.ToSample Pagination
|
||||
instance Docs.ToSample (Catalog 1) -- where
|
||||
-- toSamples _ = [("catalog", CatalogV1 docsTime (Rel "prev") (Rel "next") (Pagination (Just "previous") (Just "next")) [])]
|
||||
|
||||
docsTime :: UTCTime
|
||||
docsTime = unsafePerformIO getCurrentTime
|
||||
|
||||
|
||||
instance ToNode SubSection where
|
||||
toNode (SubSection rel) = [xml|<link type="application/atom+xml;profile=opds-catalog;kind=acquisition" rel="subsection" href="#{unRel rel}">|]
|
||||
|
||||
|
@ -1,22 +1,23 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# Language DataKinds #-}
|
||||
{-# Language TypeFamilies #-}
|
||||
{-# Language TypeOperators #-}
|
||||
{-# Language NoImplicitPrelude #-}
|
||||
{-# Language MultiParamTypeClasses #-}
|
||||
{-# Language OverloadedStrings #-}
|
||||
{-# Language TemplateHaskell #-}
|
||||
{-# Language QuasiQuotes #-}
|
||||
{-# Language RecordWildCards #-}
|
||||
{-# Language DeriveGeneric #-}
|
||||
{-# Language FlexibleInstances #-}
|
||||
{-# Language TypeApplications #-}
|
||||
{-# Language DataKinds #-}
|
||||
{-# Language DuplicateRecordFields #-}
|
||||
{-# Language NamedFieldPuns #-}
|
||||
module API.Channels (API, handler, JsonChannel(..)) where
|
||||
|
||||
import ClassyPrelude
|
||||
import Control.Lens
|
||||
import Control.Monad.Catch (MonadThrow, throwM)
|
||||
import Control.Monad.Catch (throwM, MonadThrow)
|
||||
import Control.Monad.Logger
|
||||
import Data.Aeson
|
||||
import Data.Generics.Product
|
||||
@ -24,7 +25,6 @@ import Database
|
||||
import Database.Channel
|
||||
import Servant
|
||||
import Servant.Auth as SA
|
||||
import qualified Servant.Docs as Docs
|
||||
import Server.Auth
|
||||
import Types
|
||||
|
||||
@ -36,12 +36,6 @@ data UpdateChannel = UpdateChannel { identifier :: ChannelID
|
||||
, visibility :: Visibility }
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance Docs.ToSample JsonChannel where
|
||||
toSamples _ = [("Channel", JsonChannel "channel" Private)]
|
||||
|
||||
instance Docs.ToSample UpdateChannel where
|
||||
toSamples _ = [("Channel", UpdateChannel 13 "channel" Private)]
|
||||
|
||||
instance ToJSON JsonChannel
|
||||
instance FromJSON JsonChannel
|
||||
instance ToJSON UpdateChannel
|
||||
@ -49,9 +43,6 @@ instance FromJSON UpdateChannel
|
||||
|
||||
type API = Auth '[SA.BasicAuth, SA.Cookie, SA.JWT] SafeUser :> BaseAPI
|
||||
|
||||
instance Docs.ToCapture (Capture "channel_id" ChannelID) where
|
||||
toCapture _ = Docs.DocCapture "channel_id" "The channel id"
|
||||
|
||||
type BaseAPI = "channels" :> ReqBody '[JSON] JsonChannel :> Post '[JSON] UpdateChannel
|
||||
:<|> "channels" :> Capture "channel_id" ChannelID :> ReqBody '[JSON] UpdateChannel :> Put '[JSON] UpdateChannel
|
||||
:<|> "channels" :> Get '[JSON] [JsonChannel]
|
||||
|
@ -16,7 +16,6 @@ import Database.User
|
||||
import Servant
|
||||
import Servant.Auth as SA
|
||||
import Servant.Auth.Server as SAS
|
||||
import qualified Servant.Docs as Docs
|
||||
import Server.Auth
|
||||
import Types
|
||||
import Web.FormUrlEncoded
|
||||
@ -28,17 +27,12 @@ data RegisterForm = RegisterForm { username :: Username
|
||||
, passwordAgain :: PlainPassword }
|
||||
deriving (Generic, Show)
|
||||
|
||||
instance Docs.ToSample RegisterForm
|
||||
|
||||
data LoginStatus = LoginStatus ( Maybe SafeUser ) deriving Generic
|
||||
|
||||
data RegisterStatus = RegisterStatus deriving Generic
|
||||
|
||||
instance Docs.ToSample RegisterStatus
|
||||
|
||||
instance ToJSON LoginStatus
|
||||
instance FromJSON LoginStatus
|
||||
instance Docs.ToSample LoginStatus
|
||||
|
||||
instance FromJSON RegisterForm
|
||||
instance ToJSON RegisterForm
|
||||
|
@ -1,16 +1,16 @@
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# Language NoImplicitPrelude #-}
|
||||
{-# Language DeriveGeneric #-}
|
||||
{-# Language OverloadedStrings #-}
|
||||
{-# Language DuplicateRecordFields #-}
|
||||
{-# Language GeneralizedNewtypeDeriving #-}
|
||||
module Database.Schema where
|
||||
|
||||
import ClassyPrelude
|
||||
import Data.Aeson
|
||||
import Database.Selda.Generic
|
||||
import Database.Selda
|
||||
import Database.Selda.Backend
|
||||
import Database.Selda.Generic
|
||||
import qualified Servant.Docs as Docs
|
||||
|
||||
import Data.Aeson
|
||||
import Web.HttpApiData
|
||||
|
||||
-- | User type
|
||||
@ -18,18 +18,9 @@ newtype PlainPassword = PlainPassword Text deriving (Show, ToJSON, FromJSON, ToH
|
||||
newtype HashedPassword = HashedPassword {unHashed :: ByteString}
|
||||
data NoPassword = NoPassword
|
||||
|
||||
newtype Email = Email { unEmail :: Text } deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData, Generic, Eq, IsString)
|
||||
newtype Email = Email { unEmail :: Text } deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData, Generic, Eq)
|
||||
|
||||
newtype Username = Username { unUsername :: Text } deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData, Eq, Generic, IsString)
|
||||
|
||||
instance Docs.ToSample Username where
|
||||
toSamples _ = [("Username", Username "user123")]
|
||||
|
||||
instance Docs.ToSample Email where
|
||||
toSamples _ = [("Email", Email "first.last@example.com")]
|
||||
|
||||
instance Docs.ToSample PlainPassword where
|
||||
toSamples _ = [("Password", PlainPassword "password123")]
|
||||
newtype Username = Username { unUsername :: Text } deriving (Show, ToJSON, FromJSON, ToHttpApiData, FromHttpApiData, Eq, Generic)
|
||||
|
||||
instance SqlType HashedPassword where
|
||||
mkLit = LCustom . LBlob . unHashed
|
||||
@ -51,9 +42,9 @@ instance SqlType Username where
|
||||
|
||||
newtype UserID = UserID {unUserID :: Int} deriving (Show)
|
||||
|
||||
newtype BookID = BookID {unBookID :: Int} deriving (Show, ToJSON, FromJSON, FromHttpApiData, Eq, Ord, ToHttpApiData, Generic, Num)
|
||||
newtype BookID = BookID {unBookID :: Int} deriving (Show, ToJSON, FromJSON, FromHttpApiData, Eq, Ord, ToHttpApiData, Generic)
|
||||
|
||||
newtype ChannelID = ChannelID {unChannelID :: Int} deriving (Show, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON, Eq, Generic, Num)
|
||||
newtype ChannelID = ChannelID {unChannelID :: Int} deriving (Show, ToHttpApiData, FromHttpApiData, ToJSON, FromJSON, Eq, Generic)
|
||||
|
||||
newtype TagID = TagID {unTagID :: Int} deriving (Show)
|
||||
|
||||
|
@ -1,45 +1,37 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DeriveGeneric #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# Language DataKinds #-}
|
||||
{-# Language TypeFamilies #-}
|
||||
{-# Language TypeOperators #-}
|
||||
{-# Language NoImplicitPrelude #-}
|
||||
{-# Language MultiParamTypeClasses #-}
|
||||
{-# Language OverloadedStrings #-}
|
||||
{-# Language TemplateHaskell #-}
|
||||
{-# Language QuasiQuotes #-}
|
||||
{-# Language RecordWildCards #-}
|
||||
{-# Language DeriveGeneric #-}
|
||||
{-# Language FlexibleInstances #-}
|
||||
{-# Language TypeApplications #-}
|
||||
{-# Language ScopedTypeVariables #-}
|
||||
module Server where
|
||||
|
||||
import qualified API as API
|
||||
import ClassyPrelude hiding (Handler)
|
||||
import Control.Lens
|
||||
import Control.Monad.Except
|
||||
import Control.Monad.Logger
|
||||
import Data.Generics.Product
|
||||
import Servant
|
||||
import Servant.Auth.Docs ()
|
||||
import Servant.Auth.Server as SAS
|
||||
import qualified Servant.Docs as Docs
|
||||
import Servant.HTML.Lucid (HTML)
|
||||
import Server.Auth (SafeUser)
|
||||
import Server.Auth (authCheck)
|
||||
import Servant
|
||||
import Types
|
||||
import ClassyPrelude hiding (Handler)
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Except
|
||||
import Servant.Auth.Server as SAS
|
||||
import Control.Lens
|
||||
import Data.Generics.Product
|
||||
import Server.Auth (SafeUser)
|
||||
|
||||
type API = API.API
|
||||
:<|> "help" :> Get '[PlainText, HTML] String
|
||||
:<|> "static" :> Raw
|
||||
type API = API.API :<|> "static" :> Raw
|
||||
|
||||
type Ctx = '[BasicAuthData -> IO (AuthResult SafeUser), CookieSettings, JWTSettings]
|
||||
|
||||
server :: App -> Application
|
||||
server app = serveWithContext api cfg (hoistServerWithContext (Proxy @ API.API) (Proxy @ Ctx) server' API.handler :<|> serveDocs :<|> serveDirectoryFileServer "static")
|
||||
server app = serveWithContext api cfg (hoistServerWithContext (Proxy @ API.API) (Proxy @ Ctx) server' API.handler :<|> serveDirectoryFileServer "static")
|
||||
where
|
||||
apiDocs :: Docs.API
|
||||
apiDocs = Docs.docs (Proxy @API.API)
|
||||
serveDocs = pure $ Docs.markdown apiDocs
|
||||
myKey = view (field @"jwk") app
|
||||
jwtCfg = defaultJWTSettings myKey
|
||||
authCfg = authCheck app
|
||||
|
@ -1,11 +1,11 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# Language DataKinds #-}
|
||||
{-# Language TypeFamilies #-}
|
||||
{-# Language OverloadedStrings #-}
|
||||
{-# Language NoImplicitPrelude #-}
|
||||
{-# Language TypeOperators #-}
|
||||
{-# Language DuplicateRecordFields #-}
|
||||
{-# Language TypeApplications #-}
|
||||
{-# Language TemplateHaskell #-}
|
||||
module Server.Auth
|
||||
( SafeUser(..)
|
||||
, authCheck
|
||||
@ -15,8 +15,8 @@ module Server.Auth
|
||||
|
||||
import ClassyPrelude
|
||||
import Control.Lens (view)
|
||||
import Control.Monad.Catch (MonadThrow, throwM)
|
||||
import Control.Monad.Logger
|
||||
import Control.Monad.Catch (throwM, MonadThrow)
|
||||
import Data.Aeson
|
||||
import Data.Generics.Product
|
||||
import Database
|
||||
@ -24,7 +24,6 @@ import Database.Schema
|
||||
import Database.User
|
||||
import Servant (err401)
|
||||
import Servant.Auth.Server as SAS
|
||||
import qualified Servant.Docs as Docs
|
||||
import Types
|
||||
|
||||
-- generic-lens can convert similar types to this
|
||||
@ -37,9 +36,6 @@ data SafeUser = SafeUser { email :: Email
|
||||
, role :: Role }
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance Docs.ToSample SafeUser where
|
||||
toSamples _ = [("User", SafeUser "user@example.com" "user" UserRole )]
|
||||
|
||||
instance ToJSON SafeUser where
|
||||
instance FromJSON SafeUser where
|
||||
instance ToJWT SafeUser where
|
||||
|
@ -1 +0,0 @@
|
||||
create unique index tag_owner on tags (tag, owner);
|
Loading…
Reference in New Issue
Block a user