From e0310fe4af91bc212aa50d7ccd1b33233aee2c8c Mon Sep 17 00:00:00 2001 From: "Yann Esposito (Yogsototh)" Date: Sun, 10 Mar 2019 20:44:33 +0100 Subject: [PATCH] added notion of authorizations strategies --- aggreact.cabal | 3 +- src-exe/Main.hs | 3 +- src/Aggreact.hs | 14 +++++-- src/Aggreact/Authorization.hs | 69 +++++++++++++++++++++++++++++++++ src/Aggreact/Comments/Server.hs | 6 ++- src/DevelMain.hs | 4 +- stack.yaml | 2 +- 7 files changed, 91 insertions(+), 10 deletions(-) create mode 100644 src/Aggreact/Authorization.hs diff --git a/aggreact.cabal b/aggreact.cabal index 58e9abb..c223022 100644 --- a/aggreact.cabal +++ b/aggreact.cabal @@ -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 diff --git a/src-exe/Main.hs b/src-exe/Main.hs index 38b5fc5..7e4f6b2 100644 --- a/src-exe/Main.hs +++ b/src-exe/Main.hs @@ -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 diff --git a/src/Aggreact.hs b/src/Aggreact.hs index 1aa4090..4688200 100644 --- a/src/Aggreact.hs +++ b/src/Aggreact.hs @@ -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)) diff --git a/src/Aggreact/Authorization.hs b/src/Aggreact/Authorization.hs new file mode 100644 index 0000000..7942891 --- /dev/null +++ b/src/Aggreact/Authorization.hs @@ -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 diff --git a/src/Aggreact/Comments/Server.hs b/src/Aggreact/Comments/Server.hs index 38415c3..332d021 100644 --- a/src/Aggreact/Comments/Server.hs +++ b/src/Aggreact/Comments/Server.hs @@ -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 diff --git a/src/DevelMain.hs b/src/DevelMain.hs index 882e10e..e065024 100644 --- a/src/DevelMain.hs +++ b/src/DevelMain.hs @@ -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. diff --git a/stack.yaml b/stack.yaml index 759daca..12c2dc1 100644 --- a/stack.yaml +++ b/stack.yaml @@ -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.