added notion of authorizations strategies
This commit is contained in:
parent
8874e8dc6d
commit
e0310fe4af
7 changed files with 91 additions and 10 deletions
|
@ -2,7 +2,7 @@
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: ec76b06d212428d6ff4f3f2daa7d453c6af2a54687257bb60e02c5f738d12e1d
|
||||
-- hash: 2c0743c70d80e2ac0827c17be0cfb1ca6bfd0a613a186d520ce3faeddd522550
|
||||
|
||||
name: aggreact
|
||||
version: 0.1.0.0
|
||||
|
@ -29,6 +29,7 @@ library
|
|||
exposed-modules:
|
||||
Aggreact
|
||||
Aggreact.Auth
|
||||
Aggreact.Authorization
|
||||
Aggreact.Comments
|
||||
Aggreact.Comments.Server
|
||||
Aggreact.Comments.StoreService
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
import Protolude
|
||||
|
||||
import Aggreact (mainServe,Conf(..))
|
||||
import Aggreact (mainServe,Conf(..),AuthorizationStrategy(..))
|
||||
import Database.Store.Backend.SQLite (DBConf (SQLiteConf))
|
||||
import Servant.Auth.Server
|
||||
|
||||
|
@ -14,5 +14,6 @@ main = do
|
|||
, cookieSameSite = AnySite }
|
||||
, userDBConf = SQLiteConf "aggreact.db" "users"
|
||||
, commentDBConf = SQLiteConf "aggreact.db" "comments"
|
||||
, authorizationStrategy = Anybody
|
||||
}
|
||||
mainServe conf
|
||||
|
|
|
@ -1,9 +1,9 @@
|
|||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE Strict #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE TypeSynonymInstances #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
|
||||
-- Common
|
||||
{-# LANGUAGE BlockArguments #-}
|
||||
|
@ -35,6 +35,7 @@ module Aggreact
|
|||
-- * Exported functions
|
||||
mainServe
|
||||
, Conf (..)
|
||||
, AuthorizationStrategy (..)
|
||||
, initialize
|
||||
, shutdownApp
|
||||
) where
|
||||
|
@ -42,14 +43,15 @@ module Aggreact
|
|||
import Protolude
|
||||
|
||||
import Aggreact.Auth
|
||||
import Aggreact.Authorization
|
||||
import Aggreact.Comments
|
||||
import Aggreact.Homepage
|
||||
import Aggreact.User
|
||||
|
||||
import Network.Wai (Application)
|
||||
import Network.Wai (Application)
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
import Servant
|
||||
import Servant.Auth.Server
|
||||
import Network.Wai.Handler.Warp (run)
|
||||
|
||||
data Conf =
|
||||
Conf
|
||||
|
@ -58,6 +60,7 @@ data Conf =
|
|||
, cookieSettings :: CookieSettings
|
||||
, userDBConf :: UserDBConf
|
||||
, commentDBConf :: CommentDBConf
|
||||
, authorizationStrategy :: AuthorizationStrategy
|
||||
} deriving (Eq, Show)
|
||||
|
||||
type API auths =
|
||||
|
@ -74,7 +77,7 @@ serverAuthenticated :: Settings
|
|||
-> Server Authenticated
|
||||
serverAuthenticated Settings{..} authresult =
|
||||
homepageAPI commentHandler authresult
|
||||
:<|> commentAPI (Aggreact.Comments.Handlers userHandler commentHandler) authresult
|
||||
:<|> commentAPI (Aggreact.Comments.Handlers userHandler commentHandler authorizationHandler) authresult
|
||||
:<|> userAPI userHandler authresult
|
||||
|
||||
data Settings =
|
||||
|
@ -82,6 +85,7 @@ data Settings =
|
|||
, jwtSettings :: JWTSettings
|
||||
, userHandler :: UserHandler
|
||||
, commentHandler :: CommentHandler
|
||||
, authorizationHandler :: AuthorizationHandler
|
||||
}
|
||||
|
||||
server :: Settings -> Server (API auths)
|
||||
|
@ -100,6 +104,7 @@ initialize :: Conf -> IO (Settings,Application)
|
|||
initialize Conf{..} = do
|
||||
uh <- newUserHandler userDBConf defaultAdminUser
|
||||
ch <- newCommentHandler (dbstore uh) commentDBConf
|
||||
ah <- newAuthorizationHandler authorizationStrategy
|
||||
myKey <- readKey jwtKeyFilePath
|
||||
let jwtSettings = defaultJWTSettings myKey
|
||||
cfg = cookieSettings :. jwtSettings :. EmptyContext
|
||||
|
@ -109,6 +114,7 @@ initialize Conf{..} = do
|
|||
, cookieSettings = cookieSettings
|
||||
, userHandler = uh
|
||||
, commentHandler = ch
|
||||
, authorizationHandler = ah
|
||||
}
|
||||
return ( settings
|
||||
, serveWithContext api cfg (server settings))
|
||||
|
|
69
src/Aggreact/Authorization.hs
Normal file
69
src/Aggreact/Authorization.hs
Normal file
|
@ -0,0 +1,69 @@
|
|||
{-# LANGUAGE BlockArguments #-}
|
||||
{-# LANGUAGE DerivingStrategies #-}
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE NamedWildCards #-}
|
||||
{-# LANGUAGE NoImplicitPrelude #-}
|
||||
{-# LANGUAGE NumericUnderscores #-}
|
||||
{-# LANGUAGE OverloadedLists #-}
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE PartialTypeSignatures #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{- |
|
||||
Module : Aggreact.Authorization
|
||||
Description : Example of a library file.
|
||||
Copyright : (c) 2018, Yann Esposito
|
||||
License : ISC
|
||||
Maintainer : yann.esposito@gmail.com
|
||||
Stability : experimental
|
||||
Portability : POSIX
|
||||
|
||||
This module export different authorization strategies.
|
||||
Depending on the user provide different trust mechanism
|
||||
|
||||
-}
|
||||
|
||||
module Aggreact.Authorization
|
||||
( AuthorizationStrategy (..)
|
||||
, AuthorizationHandler (..)
|
||||
, newAuthorizationHandler
|
||||
)
|
||||
where
|
||||
|
||||
import Protolude
|
||||
|
||||
import Aggreact.User (User)
|
||||
|
||||
import Servant (Handler)
|
||||
import Servant.Errors (forbidden)
|
||||
|
||||
data AuthorizationStrategy =
|
||||
Anybody
|
||||
| LoggedInOnly
|
||||
| ProgressiveTrust
|
||||
deriving (Eq, Show)
|
||||
|
||||
newtype AuthorizationHandler =
|
||||
AuthorizationHandler
|
||||
{ checkAccess :: Maybe User -> Handler Trust
|
||||
}
|
||||
|
||||
data Trust =
|
||||
Bad | New | Observation | Trusted
|
||||
deriving (Eq,Ord,Show)
|
||||
|
||||
newAuthorizationHandler :: AuthorizationStrategy -> IO AuthorizationHandler
|
||||
newAuthorizationHandler as = pure
|
||||
AuthorizationHandler
|
||||
{ checkAccess = _checkAccess as
|
||||
}
|
||||
|
||||
_checkAccess :: AuthorizationStrategy -> Maybe User -> Handler Trust
|
||||
_checkAccess Anybody _ = pure Trusted
|
||||
|
||||
_checkAccess LoggedInOnly Nothing = forbidden "You must log in"
|
||||
|
||||
_checkAccess LoggedInOnly (Just _) = pure Trusted
|
||||
|
||||
_checkAccess ProgressiveTrust Nothing = forbidden "You must log in"
|
||||
_checkAccess ProgressiveTrust (Just _) = pure Trusted
|
|
@ -39,6 +39,7 @@ import Aggreact.Comments.Types
|
|||
import Aggreact.Comments.StoreService (CommentHandler(..))
|
||||
import Aggreact.Comments.Views
|
||||
import Aggreact.User (UserHandler(..),User)
|
||||
import Aggreact.Authorization (AuthorizationHandler(..))
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Data.Time (getCurrentTime)
|
||||
|
@ -63,8 +64,9 @@ type CommentAPI =
|
|||
:> Get '[HTML,JSON] CommentPage
|
||||
|
||||
data Handlers =
|
||||
Handlers { userHandler :: UserHandler
|
||||
, commentHandler :: CommentHandler
|
||||
Handlers { userHandler :: UserHandler
|
||||
, commentHandler :: CommentHandler
|
||||
, authorizationHandler :: AuthorizationHandler
|
||||
}
|
||||
|
||||
commentAPI :: Handlers -> AuthResult User -> Server CommentAPI
|
||||
|
|
|
@ -18,7 +18,8 @@ module DevelMain where
|
|||
|
||||
import Protolude
|
||||
|
||||
import Aggreact (Conf (..), initialize,
|
||||
import Aggreact (AuthorizationStrategy (..),
|
||||
Conf (..), initialize,
|
||||
shutdownApp)
|
||||
|
||||
import Control.Concurrent (MVar, ThreadId, forkIO,
|
||||
|
@ -72,6 +73,7 @@ update = do
|
|||
, cookieSameSite = AnySite }
|
||||
, userDBConf = SQLiteConf "aggreact.db" "users"
|
||||
, commentDBConf = SQLiteConf "aggreact.db" "comments"
|
||||
, authorizationStrategy = Anybody
|
||||
}
|
||||
|
||||
-- | Start the server in a separate thread.
|
||||
|
|
|
@ -18,7 +18,7 @@
|
|||
#
|
||||
# resolver: ./custom-snapshot.yaml
|
||||
# resolver: https://example.com/snapshots/2018-01-01.yaml
|
||||
resolver: lts-13.0
|
||||
resolver: lts-13.11
|
||||
|
||||
# User packages to be built.
|
||||
# Various formats can be used as shown in the example below.
|
||||
|
|
Loading…
Reference in a new issue