apiary-authenticate 0.14.1 → 0.16.0

raw patch · 4 files changed

+101/−94 lines, 4 filesdep +monad-controldep −reflectiondep ~apiarydep ~apiary-clientsessionPVP ok

version bump matches the API change (PVP)

Dependencies added: monad-control

Dependencies removed: reflection

Dependency ranges changed: apiary, apiary-clientsession

API changes (from Hackage documentation)

Files

• apiary-authenticate.cabal +19/−16
• src/Web/Apiary/Authenticate.hs +46/−29
• src/Web/Apiary/Authenticate/Explicit.hs +0/−18
• src/Web/Apiary/Authenticate/Internal.hs +36/−31

@@ -1,5 +1,5 @@ name:                apiary-authenticate-version:             0.14.1+version:             0.16.0 synopsis:            authenticate support for apiary web framework. description:   example: <https://github.com/philopon/apiary/blob/master/examples/auth.hs>@@ -18,22 +18,25 @@  library   exposed-modules:     Web.Apiary.Authenticate-                       Web.Apiary.Authenticate.Explicit   other-modules:       Web.Apiary.Authenticate.Internal-  build-depends:       base                 >=4.6   && <4.8-                     , apiary               >=0.14  && <0.16-                     , apiary-clientsession >=0.9   && <0.14-                     , authenticate         >=1.3   && <1.4-                     , http-client          >=0.3   && <0.4-                     , http-client-tls      >=0.2   && <0.3-                     , data-default-class   >=0.0   && <0.1-                     , bytestring           >=0.10  && <0.11-                     , text                 >=1.1   && <1.2-                     , resourcet            >=1.1   && <1.2-                     , http-types           >=0.8   && <0.9-                     , blaze-builder        >=0.3   && <0.4-                     , reflection           >=1.4   && <1.6-                     , binary               >=0.7   && <0.8+  build-depends:       base                 >=4.6  && <4.8+                     , apiary               >=0.16 && <0.17+                     , apiary-clientsession >=0.16 && <0.17+                     , authenticate         >=1.3  && <1.4++                     , monad-control        >=0.3  && <0.4++                     , http-client          >=0.3  && <0.4+                     , http-client-tls      >=0.2  && <0.3++                     , data-default-class   >=0.0  && <0.1+                     , bytestring           >=0.10 && <0.11+                     , text                 >=1.1  && <1.2+                     , http-types           >=0.8  && <0.9+                     , binary               >=0.7  && <0.8++                     , resourcet            >=1.1  && <1.2+                     , blaze-builder        >=0.3  && <0.4    hs-source-dirs:      src   ghc-options:         -O2 -Wall

@@ -1,12 +1,16 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE Rank2Types #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-} -module Web.Apiary.Authenticate (-    E.AuthConfig(..), E.Provider(..)-    , E.OpenId_(..), E.OpenId-    , HasAuth-    , withAuth, withAuthWith+module Web.Apiary.Authenticate+    ( I.Auth+    , I.AuthConfig(..), I.Provider(..)+    , I.OpenId_(..), I.OpenId+    -- * initializer+    , initAuth, initAuthWith, initAuthWithManager+    -- * handler     , authHandler     -- * filter     , authorized@@ -14,49 +18,62 @@     , authLogout     -- ** getter     , authConfig, authProviders, authRoutes-    -- * reexport-    , module Data.Default.Class     ) where  import Web.Apiary-import qualified Web.Apiary.Authenticate.Explicit as E+import qualified Web.Apiary.Authenticate.Internal as I import qualified Network.HTTP.Client as Client import Network.HTTP.Client.TLS(tlsManagerSettings) import Web.Apiary.ClientSession+import Control.Monad+import Control.Monad.Trans.Control -import Data.Reflection-import Data.Default.Class-import Data.Apiary.SList import qualified Data.Text as T import qualified Data.ByteString as S -type HasAuth = Given E.Auth+import Data.Apiary.Proxy+import Data.Apiary.Extension+import Data.Apiary.Extension.Internal -withAuth :: HasSession => E.AuthConfig -> (HasAuth => IO a) -> IO a-withAuth = withAuthWith tlsManagerSettings+initAuthWithManager :: (Has Session exts, MonadBaseControl IO m)+                    => Client.Manager -> I.AuthConfig+                    -> Initializer exts m (I.Auth ': exts)+initAuthWithManager mgr conf = Initializer $ \e -> do+    I.authWith mgr conf $ \a -> return $ addExtension a e -withAuthWith :: HasSession => Client.ManagerSettings-             -> E.AuthConfig -> (HasAuth => IO a) -> IO a-withAuthWith ms ac m = E.withAuthWith given ms ac (\a -> give a m)+initAuthWith :: (Has Session exts, MonadBaseControl IO m)+             => Client.ManagerSettings -> I.AuthConfig+             -> Initializer exts m (I.Auth ': exts)+initAuthWith ms conf = Initializer $ \e -> do+    control $ \run -> Client.withManager ms $ \mgr ->+        I.authWith mgr conf $ \a -> run . return $ addExtension a e +initAuth :: (Has Session exts, MonadBaseControl IO m)+         => I.AuthConfig -> Initializer exts m (I.Auth ': exts)+initAuth = initAuthWith tlsManagerSettings+ -- | default auth handlers. since 0.8.0.0.-authHandler :: (Functor m, Monad m, Functor n, MonadIO n, HasAuth) => ApiaryT c n m ()-authHandler = E.authHandler given+authHandler :: (Monad m, MonadIO actM, Has I.Auth exts, Has Session exts)+            => ApiaryT exts prms actM m ()+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 :: HasAuth => Apiary (Snoc as E.OpenId) a -> Apiary as a-authorized = E.authorized given+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  -- | delete session. since 0.7.0.0.-authLogout :: (Monad m, HasAuth) => ActionT m ()-authLogout = E.authLogout given+authLogout :: (Monad m, Has I.Auth exts) => ActionT exts m ()+authLogout = getExt (Proxy :: Proxy I.Auth) >>= I.authLogout -authConfig :: HasAuth => E.AuthConfig-authConfig = E.authConfig given+authConfig :: (Has I.Auth exts, Monad m) => ActionT exts m I.AuthConfig+authConfig = I.config `liftM` getExt (Proxy :: Proxy I.Auth) -authProviders :: HasAuth => [(T.Text, E.Provider)]-authProviders = E.authProviders given+authProviders :: (Has I.Auth exts, Monad m) => ActionT exts 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 :: HasAuth => [(T.Text, S.ByteString)]-authRoutes = E.authRoutes given+authRoutes :: (Has I.Auth exts, Monad m) => ActionT exts m [(T.Text, S.ByteString)]+authRoutes = I.authRoutes `liftM` getExt (Proxy :: Proxy I.Auth)

@@ -1,18 +0,0 @@-module Web.Apiary.Authenticate.Explicit (-    AuthConfig(..), Provider(..)-    , Auth-    , OpenId_(..), OpenId-    , withAuth, withAuthWith-    , authHandler-    -- * filter-    , authorized-    -- * action-    , authLogout-    -- ** getter-    , authConfig, authProviders, authRoutes-    -- * reexport-    , module Data.Default.Class-    ) where--import Web.Apiary.Authenticate.Internal-import Data.Default.Class

@@ -1,9 +1,12 @@ {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FlexibleContexts #-}  module Web.Apiary.Authenticate.Internal where @@ -13,13 +16,12 @@ import Control.Monad.Trans.Resource import Control.Monad.Apiary.Filter.Internal -import Network.HTTP.Client.TLS(tlsManagerSettings) import qualified Network.HTTP.Types as HTTP import qualified Network.HTTP.Client as Client  import Web.Authenticate.OpenId-import Web.Apiary hiding(Default(..))-import Web.Apiary.ClientSession.Explicit+import Web.Apiary+import Web.Apiary.ClientSession import qualified Web.Apiary.Wai as Wai  import Data.Binary@@ -28,6 +30,8 @@ import Data.List import Data.Apiary.SList import Data.Apiary.Proxy+import Data.Apiary.Extension+import Data.Default.Class  import Blaze.ByteString.Builder import qualified Data.ByteString.Char8 as S@@ -37,15 +41,16 @@   data AuthConfig = AuthConfig-    { authSessionName  :: S.ByteString-    , authSuccessPage  :: S.ByteString-    , authUrl          :: T.Text+    { authSessionName   :: S.ByteString+    , authSuccessPage   :: S.ByteString+    , authSessionConfig :: SessionConfig+    , authUrl           :: T.Text -    , authPrefix       :: [T.Text]-    , authReturnToPath :: [T.Text]-    , authLogoutPath   :: [T.Text]+    , authPrefix        :: [T.Text]+    , authReturnToPath  :: [T.Text]+    , authLogoutPath    :: [T.Text] -    , providers        :: [(T.Text, Provider)]+    , providers         :: [(T.Text, Provider)]     }  data Provider = Provider@@ -55,32 +60,29 @@     }  instance Default AuthConfig where-    def = AuthConfig "_ID" "/" "http://localhost:3000" ["auth"] ["return_to"] ["logout"] $ +    def = AuthConfig "_ID" "/" def "http://localhost:3000" ["auth"] ["return_to"] ["logout"] $          [ ("google", Provider "https://www.google.com/accounts/o8/id" Nothing [])         , ("yahoo",  Provider "http://me.yahoo.com/"                  Nothing [])         ]  data Auth = Auth-    { manager     :: Client.Manager-    , config      :: AuthConfig-    , authSession :: Session+    { manager           :: Client.Manager+    , config            :: AuthConfig     } -withAuth :: Session -> AuthConfig -> (Auth -> IO a) -> IO a-withAuth sess = withAuthWith sess tlsManagerSettings--withAuthWith :: Session -> Client.ManagerSettings-             -> AuthConfig -> (Auth -> IO a) -> IO a-withAuthWith sess s conf m = Client.withManager s $ \mgr -> -    m (Auth mgr conf sess)+authWith :: MonadBaseControl IO m+         => Client.Manager+         -> AuthConfig -> (Auth -> m a) -> m a+authWith mgr conf m = m (Auth mgr conf) -authHandler :: (Functor m, Monad m, Functor n, MonadIO n) => Auth -> ApiaryT c n m ()+authHandler :: (Monad m, MonadIO actM, Has Session exts)+            => 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)      retH = pfxPath (authPrefix config ++ authReturnToPath config) . method GET . action $-        returnAction authSession manager (authSessionName config) (authSuccessPage config)+        returnAction (authSessionConfig config) manager (authSessionName config) (authSuccessPage config)      go name Provider{..} = pfxPath (authPrefix config ++ [name]) . method GET . action $         authAction manager providerUrl returnTo realm parameters@@ -88,8 +90,9 @@     returnTo = T.decodeUtf8 $ T.encodeUtf8 (authUrl config) `S.append`         toByteString (HTTP.encodePathSegments (authPrefix config ++ authReturnToPath config)) -authorized :: Auth -> Apiary (Snoc as OpenId) a -> Apiary as a-authorized Auth{..} = session authSession (authSessionName config) (pOne (Proxy :: Proxy OpenId))+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@@ -102,11 +105,11 @@     map (\(k,_) -> (k, toByteString . HTTP.encodePathSegments $ authPrefix (config auth) ++ [k])) $     providers (config auth) -authLogout :: Monad m => Auth -> ActionT m ()+authLogout :: Monad m => Auth -> ActionT exts m () authLogout auth = deleteCookie (authSessionName $ config auth)  authAction :: MonadIO m => Client.Manager -> T.Text -> T.Text-           -> Maybe T.Text -> [(T.Text, T.Text)] -> ActionT m ()+           -> 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     redirect $ T.encodeUtf8 fw@@ -127,6 +130,7 @@     readQuery (Just s) = case decodeOrFail (L.fromStrict s) of         Right (s',_,a) | L.null s' -> Just a         _                          -> Nothing+    qTypeRep = typeRep  type OpenId = OpenId_ T.Text @@ -136,12 +140,13 @@     (oirParams r)     (identifier <$> oirClaimed r) -returnAction :: (Functor m, MonadIO m)-             => Session -> Client.Manager -> S.ByteString -> S.ByteString -> ActionT m ()-returnAction sess mgr key to = do+returnAction :: (MonadIO m, Has Session exts)+             => SessionConfig -> Client.Manager+             -> S.ByteString -> S.ByteString -> ActionT exts m ()+returnAction sc mgr key to = do     q <- Wai.queryString <$> getRequest     r <- liftIO . runResourceT $ authenticateClaimed (mapMaybe queryElem q) mgr-    setSession sess key . L.toStrict $ encode (toOpenId r)+    setSessionWith sc key . L.toStrict $ encode (toOpenId r)     redirect to   where     queryElem (_, Nothing) = Nothing