apiary-authenticate 1.1.0 → 1.2.0

raw patch · 3 files changed

+77/−76 lines, 3 filesdep +apiary-sessiondep +cerealdep +waidep −apiary-clientsessiondep −binarydep ~apiarydep ~http-clientPVP ok

version bump matches the API change (PVP)

Dependencies added: apiary-session, cereal, wai

Dependencies removed: apiary-clientsession, binary

Dependency ranges changed: apiary, http-client

API changes (from Hackage documentation)

Files

• apiary-authenticate.cabal +6/−5
• src/Web/Apiary/Authenticate.hs +26/−22
• src/Web/Apiary/Authenticate/Internal.hs +45/−49

@@ -1,5 +1,5 @@ name:                apiary-authenticate-version:             1.1.0+version:             1.2.0 synopsis:            authenticate support for apiary web framework. description:   example: <https://github.com/philopon/apiary/blob/master/examples/auth.hs>@@ -20,20 +20,21 @@   exposed-modules:     Web.Apiary.Authenticate   other-modules:       Web.Apiary.Authenticate.Internal   build-depends:       base                 >=4.6      && <4.8-                     , apiary               >=1.1      && <1.2-                     , apiary-clientsession >=1.1      && <1.2+                     , apiary               >=1.2      && <1.3+                     , apiary-session       >=1.2      && <1.3                      , authenticate         >=1.3.2.10 && <1.4+                     , wai                  >=3.0      && <3.1                       , monad-control        >=0.3      && <0.4 -                     , http-client          >=0.3      && <0.4+                     , http-client          >=0.3      && <0.5                      , http-client-tls      >=0.2      && <0.3                       , data-default-class   >=0.0      && <0.1                      , bytestring           >=0.10     && <0.11+                     , cereal               >=0.4      && <0.5                      , text                 >=1.1      && <1.3                      , http-types           >=0.8      && <0.9-                     , binary               >=0.7      && <0.8                       , resourcet            >=1.1      && <1.2                      , blaze-builder        >=0.3      && <0.4

@@ -1,22 +1,22 @@-{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE TypeOperators #-}-{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE DataKinds #-}  module Web.Apiary.Authenticate     ( I.Auth     , I.AuthConfig(..), I.Provider(..)-    , I.OpenId_(..), I.OpenId+    , I.OpenId_(..), I.OpenId, pOpenId     -- * initializer     , initAuth, initAuthWith, initAuthWithManager     -- * handler     , authHandler     -- * filter-    , authorized+    , authorized, authorized'     -- * action-    , authLogout+    , I.authLogout     -- ** getter     , authConfig, authProviders, authRoutes     ) where@@ -25,47 +25,51 @@ 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 Web.Apiary.Session 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.Compat import Data.Apiary.Extension+import qualified Data.Apiary.Dict as Dict -initAuthWithManager :: (Has Session exts, MonadBaseControl IO m)+pOpenId :: Proxy I.OpenId+pOpenId = Proxy++initAuthWithManager :: (Has (Session I.OpenId m) exts, MonadBaseControl IO m)                     => Client.Manager -> I.AuthConfig                     -> Initializer m exts (I.Auth ': exts) initAuthWithManager mgr conf = initializer' $ return (I.Auth mgr conf) -initAuthWith :: (Has Session exts, MonadBaseControl IO m)+initAuthWith :: (Has (Session I.OpenId m) exts, MonadBaseControl IO m)              => Client.ManagerSettings -> I.AuthConfig              -> Initializer m exts (I.Auth ': exts) initAuthWith ms conf = initializerBracket' $ \m ->     control $ \run -> Client.withManager ms (\mgr -> run . m $ I.Auth mgr conf) -initAuth :: (Has Session exts, MonadBaseControl IO m)+initAuth :: (Has (Session I.OpenId m) exts, MonadBaseControl IO m)          => I.AuthConfig -> Initializer m exts (I.Auth ': exts) initAuth = initAuthWith tlsManagerSettings  -- | default auth handlers. since 0.8.0.0.-authHandler :: (Monad m, MonadIO actM, Has I.Auth exts, Has Session exts)+authHandler :: (Monad m, MonadIO actM, Has I.Auth exts, Has (Session I.OpenId actM) exts)             => ApiaryT exts prms actM m ()-authHandler = apiaryExt (Proxy :: Proxy I.Auth) >>= I.authHandler +authHandler = getExt (Proxy :: Proxy I.Auth) >>= I.authHandler  --- | filter which check whether logged in or not, and get id. since 0.7.0.0.-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))+authorized' :: (Has (Session I.OpenId actM) exts, KnownSymbol key, Monad actM, Dict.NotMember key kvs)+            => proxy key+            -> ApiaryT exts (key := I.OpenId ': kvs) actM m ()+            -> ApiaryT exts kvs actM m ()+authorized' ky = session' ky (Proxy :: Proxy I.OpenId) --- | delete session. since 0.7.0.0.-authLogout :: (Monad m, Has I.Auth exts) => ActionT exts prms m ()-authLogout = getExt (Proxy :: Proxy I.Auth) >>= I.authLogout+-- | filter which check whether logged in or not, and get id. since 0.7.0.0.+authorized :: (Has (Session I.OpenId actM) exts, Monad actM, Dict.NotMember "auth" kvs)+           => ApiaryT exts ("auth" := I.OpenId ': kvs) actM m ()+           -> ApiaryT exts kvs actM m ()+authorized = authorized' (Proxy :: Proxy "auth")  authConfig :: (Has I.Auth exts, Monad m) => ActionT exts prms m I.AuthConfig authConfig = I.config `liftM` getExt (Proxy :: Proxy I.Auth)

@@ -11,41 +11,38 @@  module Web.Apiary.Authenticate.Internal where -import GHC.Generics(Generic)--import Control.Applicative-import Control.Monad.Trans.Resource-import Control.Monad.Apiary.Filter-import Control.Monad.Apiary.Action+import Control.Applicative((<$>), (<*>))+import Control.Monad.Trans.Resource(runResourceT)+import Control.Monad.Apiary(ApiaryT, action)+import Control.Monad.Apiary.Filter(function, method)+import Control.Monad.Apiary.Action(ActionT, getRequest, redirect) +import qualified Network.Wai as Wai import qualified Network.HTTP.Types as HTTP import qualified Network.HTTP.Client as Client+import qualified Web.Authenticate.OpenId as OpenId -import Web.Authenticate.OpenId-import Web.Apiary-import Web.Apiary.ClientSession-import qualified Web.Apiary.Wai as Wai+import Web.Apiary(MonadIO(..))+import Web.Apiary.Session(Session, deleteSession, setSession) -import Data.Binary as Binary-import Data.Apiary.Extension+import Data.Apiary.Extension(Has, Extension)+import Data.Apiary.Compat(Proxy(Proxy), Typeable)+import Data.Apiary.Method(Method(GET))++import qualified Data.Serialize as Serialize import Data.Data (Data)-import Data.Maybe-import Data.List-import Data.Apiary.Compat-import Data.Apiary.Param-import Data.Default.Class+import Data.Maybe(mapMaybe)+import Data.List(isPrefixOf)+import Data.Default.Class(Default(..)) -import Blaze.ByteString.Builder+import Blaze.ByteString.Builder(toByteString) 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   data AuthConfig = AuthConfig-    { authSessionName   :: S.ByteString-    , authSuccessPage   :: S.ByteString-    , authSessionConfig :: SessionConfig+    { authSuccessPage   :: S.ByteString     , authUrl           :: T.Text      , authPrefix        :: [T.Text]@@ -62,7 +59,7 @@     }  instance Default AuthConfig where-    def = AuthConfig "_ID" "/" def "http://localhost:3000" ["auth"] ["return_to"] ["logout"] $ +    def = AuthConfig "/" "http://localhost:3000" ["auth"] ["return_to"] ["logout"] $          [ ("google", Provider "https://www.google.com/accounts/o8/id" Nothing [])         , ("yahoo",  Provider "http://me.yahoo.com/"                  Nothing [])         ]@@ -73,14 +70,14 @@     } instance Extension Auth -authHandler :: (Monad m, MonadIO actM, Has Session exts)+authHandler :: (Monad m, MonadIO actM, Has (Session OpenId actM) exts)             => Auth -> ApiaryT exts prms actM m () authHandler Auth{..} = retH >> mapM_ (uncurry go) (providers config)   where     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)+        returnAction manager (authSuccessPage config)      go name Provider{..} = pfxPath (authPrefix config ++ [name]) . method GET . action $         authAction manager providerUrl returnTo realm parameters@@ -99,48 +96,47 @@     map (\(k,_) -> (k, toByteString . HTTP.encodePathSegments $ authPrefix (config auth) ++ [k])) $     providers (config auth) -authLogout :: Monad m => Auth -> ActionT exts prms m ()-authLogout auth = deleteCookie (authSessionName $ config auth)+-- | delete session. since 0.7.0.0.+authLogout :: (Has (Session OpenId m) exts, Monad m) => ActionT exts prms m ()+authLogout = deleteSession (Proxy :: Proxy OpenId)  authAction :: MonadIO m => Client.Manager -> T.Text -> T.Text            -> 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+    fw <- liftIO . runResourceT $ OpenId.getForwardUrl uri returnTo realm prm mgr     redirect $ T.encodeUtf8 fw  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)+    } deriving (Show, Read, Eq, Ord, Data, Typeable, Functor) -instance Binary (OpenId_ T.Text) where-    get   = fmap (fmap T.decodeUtf8) (Binary.get :: Get (OpenId_ S.ByteString))-    put g = put (fmap T.encodeUtf8 g)+instance Serialize.Serialize (OpenId_ S.ByteString) where+    put (OpenId_ loc prm cld) = do+        Serialize.put loc+        Serialize.put prm+        Serialize.put cld+    get = OpenId_ <$> Serialize.get <*> Serialize.get <*> Serialize.get -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-    qTypeRep = typeRep+instance Serialize.Serialize (OpenId_ T.Text) where+    get = fmap (fmap T.decodeUtf8) Serialize.get+    put = Serialize.put . fmap T.encodeUtf8  type OpenId = OpenId_ T.Text -toOpenId :: OpenIdResponse -> OpenId+toOpenId :: OpenId.OpenIdResponse -> OpenId toOpenId r = OpenId_ -    (identifier $ oirOpLocal r)-    (oirParams r)-    (identifier <$> oirClaimed r)+    (OpenId.identifier $ OpenId.oirOpLocal r)+    (OpenId.oirParams r)+    (OpenId.identifier <$> OpenId.oirClaimed r) -returnAction :: (MonadIO m, Has Session exts)-             => SessionConfig -> Client.Manager-             -> S.ByteString -> S.ByteString -> ActionT exts prms m ()-returnAction sc mgr ky to = do+returnAction :: (MonadIO m, Has (Session OpenId m) exts)+             => Client.Manager -> S.ByteString -> ActionT exts prms m ()+returnAction mgr to = do     q <- Wai.queryString <$> getRequest-    r <- liftIO . runResourceT $ authenticateClaimed (mapMaybe queryElem q) mgr-    setSessionWith sc ky . L.toStrict $ encode (toOpenId r)+    r <- liftIO . runResourceT $ OpenId.authenticateClaimed (mapMaybe queryElem q) mgr+    setSession Proxy (toOpenId r)     redirect to   where     queryElem (_, Nothing) = Nothing