apiary-authenticate 0.17.0 → 1.0.0
raw patch · 3 files changed
+30/−30 lines, 3 filesdep ~apiarydep ~apiary-clientsession
Dependency ranges changed: apiary, apiary-clientsession
Files
- apiary-authenticate.cabal +3/−3
- src/Web/Apiary/Authenticate.hs +12/−10
- src/Web/Apiary/Authenticate/Internal.hs +15/−17
apiary-authenticate.cabal view
@@ -1,5 +1,5 @@ name: apiary-authenticate-version: 0.17.0+version: 1.0.0 synopsis: authenticate support for apiary web framework. description: example: <https://github.com/philopon/apiary/blob/master/examples/auth.hs>@@ -20,8 +20,8 @@ exposed-modules: Web.Apiary.Authenticate other-modules: Web.Apiary.Authenticate.Internal build-depends: base >=4.6 && <4.8- , apiary >=0.17 && <0.18- , apiary-clientsession >=0.17 && <0.18+ , apiary >=1.0 && <1.1+ , apiary-clientsession >=1.0 && <1.1 , authenticate >=1.3.2.10 && <1.4 , monad-control >=0.3 && <0.4
src/Web/Apiary/Authenticate.hs view
@@ -3,6 +3,7 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} module Web.Apiary.Authenticate ( I.Auth@@ -27,11 +28,13 @@ import Web.Apiary.ClientSession import Control.Monad import Control.Monad.Trans.Control+import Control.Monad.Apiary+import Control.Monad.Apiary.Action import qualified Data.Text as T import qualified Data.ByteString as S -import Data.Apiary.Proxy+import Data.Apiary.Compat import Data.Apiary.Extension initAuthWithManager :: (Has Session exts, MonadBaseControl IO m)@@ -55,22 +58,21 @@ authHandler = apiaryExt (Proxy :: Proxy I.Auth) >>= I.authHandler -- | filter which check whether logged in or not, and get id. since 0.7.0.0.-authorized :: (Has I.Auth exts, MonadIO actM, Has Session exts)- => ApiaryT exts (I.OpenId ': prms) actM m () -> ApiaryT exts prms actM m ()-authorized m = do- a <- apiaryExt (Proxy :: Proxy I.Auth)- I.authorized a m+authorized :: (Has Session exts, MonadIO actM, KnownSymbol k, NotMember k prms)+ => proxy k -> ApiaryT exts (k := I.OpenId ': prms) actM m ()+ -> ApiaryT exts prms actM m ()+authorized ky = session ky (pOne (Proxy :: Proxy I.OpenId)) -- | delete session. since 0.7.0.0.-authLogout :: (Monad m, Has I.Auth exts) => ActionT exts m ()+authLogout :: (Monad m, Has I.Auth exts) => ActionT exts prms m () authLogout = getExt (Proxy :: Proxy I.Auth) >>= I.authLogout -authConfig :: (Has I.Auth exts, Monad m) => ActionT exts m I.AuthConfig+authConfig :: (Has I.Auth exts, Monad m) => ActionT exts prms m I.AuthConfig authConfig = I.config `liftM` getExt (Proxy :: Proxy I.Auth) -authProviders :: (Has I.Auth exts, Monad m) => ActionT exts m [(T.Text, I.Provider)]+authProviders :: (Has I.Auth exts, Monad m) => ActionT exts prms m [(T.Text, I.Provider)] authProviders = I.authProviders `liftM` getExt (Proxy :: Proxy I.Auth) -- | get authenticate routes: (title, route). since 0.7.0.0.-authRoutes :: (Has I.Auth exts, Monad m) => ActionT exts m [(T.Text, S.ByteString)]+authRoutes :: (Has I.Auth exts, Monad m) => ActionT exts prms m [(T.Text, S.ByteString)] authRoutes = I.authRoutes `liftM` getExt (Proxy :: Proxy I.Auth)
src/Web/Apiary/Authenticate/Internal.hs view
@@ -7,6 +7,7 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeFamilies #-} module Web.Apiary.Authenticate.Internal where @@ -14,7 +15,8 @@ import Control.Applicative import Control.Monad.Trans.Resource-import Control.Monad.Apiary.Filter.Internal+import Control.Monad.Apiary.Filter+import Control.Monad.Apiary.Action import qualified Network.HTTP.Types as HTTP import qualified Network.HTTP.Client as Client@@ -24,12 +26,12 @@ import Web.Apiary.ClientSession import qualified Web.Apiary.Wai as Wai -import Data.Binary+import Data.Binary as Binary import Data.Data (Data) import Data.Maybe import Data.List-import Data.Apiary.SList-import Data.Apiary.Proxy+import Data.Apiary.Compat+import Data.Apiary.Param import Data.Default.Class import Blaze.ByteString.Builder@@ -73,7 +75,7 @@ => Auth -> ApiaryT exts prms actM m () authHandler Auth{..} = retH >> mapM_ (uncurry go) (providers config) where- pfxPath p = function id (\_ r -> if p `isPrefixOf` Wai.pathInfo r then Just SNil else Nothing)+ pfxPath p = function id (\d r -> if p `isPrefixOf` Wai.pathInfo r then Just d else Nothing) retH = pfxPath (authPrefix config ++ authReturnToPath config) . method GET . action $ returnAction (authSessionConfig config) manager (authSessionName config) (authSuccessPage config)@@ -84,10 +86,6 @@ returnTo = T.decodeUtf8 $ T.encodeUtf8 (authUrl config) `S.append` toByteString (HTTP.encodePathSegments (authPrefix config ++ authReturnToPath config)) -authorized :: (MonadIO actM, Has Session exts)- => Auth -> ApiaryT exts (OpenId ': prms) actM m () -> ApiaryT exts prms actM m ()-authorized Auth{..} = session (authSessionName config) (pOne (Proxy :: Proxy OpenId))- authConfig :: Auth -> AuthConfig authConfig = config @@ -99,13 +97,13 @@ map (\(k,_) -> (k, toByteString . HTTP.encodePathSegments $ authPrefix (config auth) ++ [k])) $ providers (config auth) -authLogout :: Monad m => Auth -> ActionT exts m ()+authLogout :: Monad m => Auth -> ActionT exts prms m () authLogout auth = deleteCookie (authSessionName $ config auth) authAction :: MonadIO m => Client.Manager -> T.Text -> T.Text- -> Maybe T.Text -> [(T.Text, T.Text)] -> ActionT exts m ()-authAction mgr uri returnTo realm param = do- fw <- liftIO . runResourceT $ getForwardUrl uri returnTo realm param mgr+ -> Maybe T.Text -> [(T.Text, T.Text)] -> ActionT exts prms m ()+authAction mgr uri returnTo realm prm = do+ fw <- liftIO . runResourceT $ getForwardUrl uri returnTo realm prm mgr redirect $ T.encodeUtf8 fw data OpenId_ a = OpenId_@@ -116,7 +114,7 @@ instance Binary (OpenId_ S.ByteString) instance Binary (OpenId_ T.Text) where- get = fmap (fmap T.decodeUtf8) (get :: Get (OpenId_ S.ByteString))+ get = fmap (fmap T.decodeUtf8) (Binary.get :: Get (OpenId_ S.ByteString)) put g = put (fmap T.encodeUtf8 g) instance Query (OpenId_ T.Text) where@@ -136,11 +134,11 @@ returnAction :: (MonadIO m, Has Session exts) => SessionConfig -> Client.Manager- -> S.ByteString -> S.ByteString -> ActionT exts m ()-returnAction sc mgr key to = do+ -> S.ByteString -> S.ByteString -> ActionT exts prms m ()+returnAction sc mgr ky to = do q <- Wai.queryString <$> getRequest r <- liftIO . runResourceT $ authenticateClaimed (mapMaybe queryElem q) mgr- setSessionWith sc key . L.toStrict $ encode (toOpenId r)+ setSessionWith sc ky . L.toStrict $ encode (toOpenId r) redirect to where queryElem (_, Nothing) = Nothing