apiary-authenticate 0.8.0.0 → 0.9.0.0

raw patch · 4 files changed

+134/−52 lines, 4 filesdep +binarydep +taggeddep −waidep ~apiarydep ~apiary-clientsessionPVP ok

version bump matches the API change (PVP)

Dependencies added: binary, tagged

Dependencies removed: wai

Dependency ranges changed: apiary, apiary-clientsession

API changes (from Hackage documentation)

Files

• apiary-authenticate.cabal +6/−4
• src/Web/Apiary/Authenticate.hs +47/−2
• src/Web/Apiary/Authenticate/Explicit.hs +18/−0
• src/Web/Apiary/Authenticate/Internal.hs +63/−46

@@ -1,5 +1,5 @@ name:                apiary-authenticate-version:             0.8.0.0+version:             0.9.0.0 synopsis:            authenticate support for apiary web framework. description:   example: <https://github.com/philopon/apiary/blob/master/examples/auth.hs>@@ -18,21 +18,23 @@  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.8   && <0.9-                     , apiary-clientsession >=0.8   && <0.9+                     , apiary               >=0.9   && <0.10+                     , apiary-clientsession >=0.9   && <0.10                      , 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-                     , wai                  >=2.1   && <2.2                      , resourcet            >=1.1   && <1.2                      , http-types           >=0.8   && <0.9                      , blaze-builder        >=0.3   && <0.4                      , reflection           >=1.4   && <1.5+                     , binary               >=0.7   && <0.8+                     , tagged               >=0.7   && <0.8    hs-source-dirs:      src   ghc-options:         -O2 -Wall

@@ -1,5 +1,10 @@+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE Rank2Types #-}+ module Web.Apiary.Authenticate (-    AuthConfig(..), Provider(..)+    E.AuthConfig(..), E.Provider(..)+    , E.OpenId_(..), E.OpenId     , HasAuth     , withAuth, withAuthWith     , authHandler@@ -13,5 +18,45 @@     , module Data.Default.Class     ) where -import Web.Apiary.Authenticate.Internal+import Web.Apiary+import qualified Web.Apiary.Authenticate.Explicit as E+import qualified Network.HTTP.Client as Client+import Network.HTTP.Client.TLS(tlsManagerSettings)+import Web.Apiary.ClientSession++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++withAuth :: HasSession => E.AuthConfig -> (HasAuth => IO a) -> IO a+withAuth = withAuthWith tlsManagerSettings++withAuthWith :: HasSession => Client.ManagerSettings+             -> E.AuthConfig -> (HasAuth => IO a) -> IO a+withAuthWith ms ac m = E.withAuthWith given ms ac (\a -> give a m)++-- | default auth handlers. since 0.8.0.0.+authHandler :: (Functor n, MonadIO n, HasAuth) => ApiaryT c n m ()+authHandler = E.authHandler given++-- | 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++-- | delete session. since 0.7.0.0.+authLogout :: (Monad m, HasAuth) => ActionT m ()+authLogout = E.authLogout given++authConfig :: HasAuth => E.AuthConfig+authConfig = E.authConfig given++authProviders :: HasAuth => [(T.Text, E.Provider)]+authProviders = E.authProviders given++-- | get authenticate routes: (title, route). since 0.7.0.0.+authRoutes :: HasAuth => [(T.Text, S.ByteString)]+authRoutes = E.authRoutes given

@@ -0,0 +1,18 @@+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,26 +1,29 @@-{-# LANGUAGE NoMonomorphismRestriction #-}-{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ImplicitParams #-}-{-# LANGUAGE ConstraintKinds #-}-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}  module Web.Apiary.Authenticate.Internal where  import Control.Monad.Trans.Resource import Control.Applicative +import GHC.Generics(Generic)+import Data.Binary+import Data.Data import Data.Maybe import Data.List import Data.Default.Class-import Data.Reflection+import Data.Proxy -- for ghc-7.6 import qualified Data.ByteString.Char8 as S+import qualified Data.ByteString.Lazy as L import qualified Data.Text as T import qualified Data.Text.Encoding as T import Blaze.ByteString.Builder -import qualified Network.Wai as Wai+import qualified Web.Apiary.Wai as Wai import qualified Network.HTTP.Types as HTTP import qualified Network.HTTP.Client as Client import Network.HTTP.Client.TLS(tlsManagerSettings)@@ -29,7 +32,7 @@ import Web.Apiary hiding(Default(..)) import Data.Apiary.SList import Control.Monad.Apiary.Filter.Internal-import Web.Apiary.ClientSession+import Web.Apiary.ClientSession.Explicit  data AuthConfig = AuthConfig     { authSessionName  :: S.ByteString@@ -56,29 +59,26 @@         ]  data Auth = Auth-    { manager :: Client.Manager-    , config  :: AuthConfig+    { manager     :: Client.Manager+    , config      :: AuthConfig+    , authSession :: Session     } -type HasAuth = (Given Auth, HasSession)--withAuth :: HasSession => AuthConfig -> (HasAuth => IO a) -> IO a-withAuth = withAuthWith tlsManagerSettings+withAuth :: Session -> AuthConfig -> (Auth -> IO a) -> IO a+withAuth sess = withAuthWith sess tlsManagerSettings -withAuthWith :: HasSession => Client.ManagerSettings-             -> AuthConfig -> (HasAuth => IO a) -> IO a-withAuthWith s conf m = Client.withManager s $ \mgr -> -    give (Auth mgr conf) m+withAuthWith :: Session -> Client.ManagerSettings+             -> AuthConfig -> (Auth -> IO a) -> IO a+withAuthWith sess s conf m = Client.withManager s $ \mgr -> +    m (Auth mgr conf sess) --- | default auth handlers. since 0.8.0.0.-authHandler :: (Functor n, MonadIO n, HasAuth) => ApiaryT c n m ()-authHandler = retH >> mapM_ (uncurry go) (providers config)+authHandler :: (Functor n, MonadIO n) => Auth -> ApiaryT c n m ()+authHandler Auth{..} = retH >> mapM_ (uncurry go) (providers config)   where-    Auth{..}  = given     pfxPath p = function (\_ r -> if p `isPrefixOf` Wai.pathInfo r then Just SNil else Nothing)      retH = pfxPath (authPrefix config ++ authReturnToPath config) . stdMethod GET . action $-        returnAction manager (authSessionName config) (authSuccessPage config)+        returnAction authSession manager (authSessionName config) (authSuccessPage config)      go name Provider{..} = pfxPath (authPrefix config ++ [name]) . stdMethod GET . action $         authAction manager providerUrl returnTo realm parameters@@ -86,30 +86,22 @@     returnTo = T.decodeUtf8 $ T.encodeUtf8 (authUrl config) `S.append`         toByteString (HTTP.encodePathSegments (authPrefix config ++ authReturnToPath config)) ---- | filter which check whether logged in or not, and get id. since 0.7.0.0.-authorized :: HasAuth => Apiary (Snoc as S.ByteString) a -> Apiary as a-authorized = session (authSessionName $ config given) (pOne pByteString)+authorized :: Auth -> Apiary (Snoc as OpenId) a -> Apiary as a+authorized Auth{..} = session authSession (authSessionName config) (pOne (Proxy :: Proxy OpenId)) --- | get auth config. since 0.7.0.0.-authConfig :: (Monad m, HasAuth) => ActionT m AuthConfig-authConfig = return (config given)+authConfig :: Auth -> AuthConfig+authConfig = config --- | get providers. since 0.7.0.0.-authProviders :: (Monad m, HasAuth) => ActionT m [(T.Text, Provider)]-authProviders = providers <$> authConfig+authProviders :: Auth -> [(T.Text, Provider)]+authProviders = providers . config --- | get authenticate routes: (title, route). since 0.7.0.0.-authRoutes :: (Monad m, HasAuth) => ActionT m [(T.Text, S.ByteString)]-authRoutes = do -    conf <- authConfig-    return . map (\(k,_) -> (k, toByteString . HTTP.encodePathSegments $ authPrefix conf ++ [k])) $ providers conf+authRoutes :: Auth -> [(T.Text, S.ByteString)]+authRoutes auth =+    map (\(k,_) -> (k, toByteString . HTTP.encodePathSegments $ authPrefix (config auth) ++ [k])) $+    providers (config auth) --- | delete session. since 0.7.0.0.-authLogout :: (Monad m,  HasAuth) => ActionT m ()-authLogout = do-    conf <- authConfig-    deleteCookie (authSessionName conf)+authLogout :: Monad m => Auth -> ActionT 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 ()@@ -117,11 +109,36 @@     fw <- liftIO . runResourceT $ getForwardUrl uri returnTo realm param mgr     redirect $ T.encodeUtf8 fw -returnAction :: (MonadIO m, HasSession) => Client.Manager -> S.ByteString -> S.ByteString -> ActionT m ()-returnAction mgr key to = do+data OpenId_ a = OpenId_+    { opLocal :: a+    , params  :: [(a, a)]+    , claimed :: Maybe a+    } deriving (Show, Read, Eq, Ord, Data, Typeable, Generic, Functor)+instance Binary (OpenId_ S.ByteString)++instance Binary (OpenId_ T.Text) where+    get   = fmap (fmap T.decodeUtf8) (get :: Get (OpenId_ S.ByteString))+    put g = put (fmap T.encodeUtf8 g)++instance Query (OpenId_ T.Text) where+    readQuery Nothing  = Nothing+    readQuery (Just s) = case decodeOrFail (L.fromStrict s) of+        Right (s',_,a) | L.null s' -> Just a+        _                          -> Nothing++type OpenId = OpenId_ T.Text++toOpenId :: OpenIdResponse -> OpenId+toOpenId r = OpenId_ +    (identifier $ oirOpLocal r)+    (oirParams r)+    (identifier <$> oirClaimed r)++returnAction :: MonadIO m => Session -> Client.Manager -> S.ByteString -> S.ByteString -> ActionT m ()+returnAction sess mgr key to = do     q <- Wai.queryString <$> getRequest     r <- liftIO . runResourceT $ authenticateClaimed (mapMaybe queryElem q) mgr-    setSession key (T.encodeUtf8 . identifier $ oirOpLocal r)+    setSession sess key . L.toStrict $ encode (toOpenId r)     redirect to   where     queryElem (_, Nothing) = Nothing