yesod-auth-deskcom 1.1 → 1.2
raw patch · 3 files changed
+80/−56 lines, 3 filesdep +cprng-aesdep +cryptohash-cryptoapidep ~yesod-authdep ~yesod-core
Dependencies added: cprng-aes, cryptohash-cryptoapi
Dependency ranges changed: yesod-auth, yesod-core
Files
- src/Yesod/Auth/DeskCom.hs +41/−42
- src/Yesod/Auth/DeskCom/Data.hs +20/−0
- yesod-auth-deskcom.cabal +19/−14
src/Yesod/Auth/DeskCom.hs view
@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} module Yesod.Auth.DeskCom ( YesodDeskCom(..) , deskComCreateCreds@@ -6,17 +7,16 @@ , DeskComUserId(..) , DeskComCustomField , DeskCom- , getDeskCom+ , initDeskCom , deskComLoginRoute , deskComMaybeLoginRoute ) where import Control.Applicative ((<$>))-import Control.Monad.IO.Class (MonadIO, liftIO)+import Crypto.Hash.CryptoAPI (SHA1) import Data.Default (Default(..)) import Data.Monoid ((<>)) import Data.Text (Text)-import Language.Haskell.TH.Syntax (Pred(ClassP), Type(VarT), mkName) import Network.HTTP.Types (renderSimpleQuery) import Yesod.Auth import Yesod.Core@@ -25,21 +25,23 @@ import qualified Crypto.Hash.SHA1 as SHA1 import qualified Crypto.HMAC as HMAC import qualified Crypto.Padding as Padding+import qualified Crypto.Random.AESCtr as CPRNG import qualified Data.Aeson as A import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Base64 as B64 import qualified Data.ByteString.Base64.URL as B64URL+import qualified Data.IORef as I import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Time as TI-+import Yesod.Auth.DeskCom.Data -- | Type class that you need to implement in order to support -- Desk.com remote authentication. -- -- /Minimal complete definition:/ everything except for 'deskComTokenTimeout'.-class YesodAuth master => YesodDeskCom master where+class YesodAuthPersist master => YesodDeskCom master where -- | The credentials needed to use Multipass. Use -- 'deskComCreateCreds'. We recommend caching the resulting -- 'DeskComCredentials' value on your foundation data type@@ -79,7 +81,7 @@ -- 'maybeAuth' instead of 'requireAuth' and login on Desk.com -- with some sort of guest user should the user not be logged -- in.- deskComUserInfo :: AuthId master -> GHandler DeskCom master DeskComUser+ deskComUserInfo :: AuthId master -> HandlerT master IO DeskComUser -- | Each time we login an user on Desk.com, we create a token. -- This function defines how much time the token should be@@ -88,6 +90,8 @@ deskComTokenTimeout :: master -> TI.NominalDiffTime deskComTokenTimeout _ = 300 -- seconds +instance YesodDeskCom master => YesodSubDispatch DeskCom (HandlerT master IO) where+ yesodSubDispatch = $(mkYesodSubDispatch resourcesDeskCom) -- | Create the credentials data type used by this library. This -- function is relatively expensive (uses SHA1 and AES), so@@ -104,7 +108,7 @@ where -- Yes, I know, Desk.com's crypto is messy. aesKey = AES.initKey . B.take 16 . SHA1.hash . TE.encodeUtf8 $ apiKey <> site- hmacKey = HMAC.MacKey $ TE.encodeUtf8 apiKey+ hmacKey = TE.encodeUtf8 apiKey -- | Credentials used to access your Desk.com's Multipass.@@ -113,7 +117,7 @@ { dccSite :: !T.Text , dccDomain :: !T.Text , dccAesKey :: !AES.Key- , dccHmacKey :: !(HMAC.MacKey SHA1.Ctx SHA1.SHA1)+ , dccHmacKey :: !B.ByteString -- HMAC.MacKey ?????? SHA1 } @@ -177,23 +181,6 @@ ---------------------------------------------------------------------- --- | Data type for @yesod-auth-deskCom@\'s subsite.-data DeskCom = DeskCom----- | Create a new 'DeskCom', use this on your @config/routes@ file.-getDeskCom :: a -> DeskCom-getDeskCom = const DeskCom---mkYesodSub "DeskCom"- [ClassP ''YesodDeskCom [VarT $ mkName "master"]]- [parseRoutes|- / DeskComLoginR GET- /m DeskComMaybeLoginR GET-|]-- -- | Redirect the user to Desk.com such that they're already -- logged in when they arrive. For example, you may use -- @deskComLoginRoute@ as the login URL on Multipass config.@@ -210,45 +197,51 @@ deskComMaybeLoginRoute :: Route DeskCom deskComMaybeLoginRoute = DeskComMaybeLoginR - -- | Route used by the Desk.com remote authentication. Works -- both when Desk.com call us and when we call them. Forces user -- to be logged in.-getDeskComLoginR :: YesodDeskCom master => GHandler DeskCom master ()-getDeskComLoginR = requireAuthId >>= redirectToMultipass+getDeskComLoginR :: YesodDeskCom master+ => HandlerT DeskCom (HandlerT master IO) ()+getDeskComLoginR = lift requireAuthId >>= redirectToMultipass -- | Same as 'getDeskComLoginR' if the user is logged in, -- otherwise redirect to the Desk.com portal without asking for -- credentials.-getDeskComMaybeLoginR :: YesodDeskCom master => GHandler DeskCom master ()-getDeskComMaybeLoginR = maybeAuthId >>= maybe redirectToPortal redirectToMultipass+getDeskComMaybeLoginR :: YesodDeskCom master+ => HandlerT DeskCom (HandlerT master IO) ()+getDeskComMaybeLoginR = lift maybeAuthId >>= maybe redirectToPortal redirectToMultipass -- | Redirect the user to the main Desk.com portal.-redirectToPortal :: YesodDeskCom master => GHandler DeskCom master ()+redirectToPortal :: YesodDeskCom master => HandlerT DeskCom (HandlerT master IO) () redirectToPortal = do- y <- getYesod+ y <- lift getYesod let DeskComCredentials {..} = deskComCredentials y redirect $ T.concat [ "http://", dccDomain, "/" ] -- | Redirect the user to the multipass login.-redirectToMultipass :: YesodDeskCom master => AuthId master -> GHandler DeskCom master ()+redirectToMultipass :: YesodDeskCom master+ => AuthId master+ -> HandlerT DeskCom (HandlerT master IO) () redirectToMultipass uid = do -- Get generic info.- y <- getYesod+ y <- lift getYesod let DeskComCredentials {..} = deskComCredentials y -- Get the expires timestamp. expires <- TI.addUTCTime (deskComTokenTimeout y) <$> liftIO TI.getCurrentTime -- Get information about the currently logged user.- DeskComUser {..} <- deskComUserInfo uid+ DeskComUser {..} <- lift (deskComUserInfo uid) userId <- case duUserId of- UseYesodAuthId -> toPathPiece <$> requireAuthId+ UseYesodAuthId -> toPathPiece <$> lift requireAuthId Explicit x -> return x + -- Generate an IV.+ iv@(AES.IV ivBS) <- deskComRandomIV+ -- Create Multipass token. let toStrict = B.concat . BL.toChunks deskComEncode@@ -256,12 +249,15 @@ . B64URL.encode -- base64url encoding encrypt = deskComEncode -- encode as modified base64url- . AES.encryptCBC dccAesKey blankIV -- encrypt with AES128-CBC+ . AES.encryptCBC dccAesKey iv -- encrypt with AES128-CBC+ . (ivBS <>) -- prepend the IV . Padding.padPKCS5 16 -- PKCS#5 padding . toStrict . A.encode . A.object -- encode as JSON sign = B64.encode . Crypto.encode -- encode as normal base64 (why??? =[)- . HMAC.hmac' dccHmacKey -- sign using HMAC-SHA1+ . HMAC.hmac' hmacKey -- sign using HMAC-SHA1+ hmacKey :: HMAC.MacKey ctx SHA1+ hmacKey = HMAC.MacKey dccHmacKey multipass = encrypt $ "uid" A..= userId : "expires" A..= expires :@@ -280,7 +276,10 @@ ] --- | A blank IV consisting of NUL bytes. Yes, Desk.com's messy--- crypto avoids using IVs!-blankIV :: AES.IV-blankIV = AES.IV (B.replicate 16 0)+-- | Randomly generate an IV.+deskComRandomIV :: HandlerT DeskCom (HandlerT master IO) AES.IV+deskComRandomIV = do+ var <- deskComCprngVar <$> getYesod+ liftIO $ I.atomicModifyIORef var $+ \g -> let (bs, g') = CPRNG.genRandomBytes 16 g+ in (g', g' `seq` AES.IV bs)
+ src/Yesod/Auth/DeskCom/Data.hs view
@@ -0,0 +1,20 @@+module Yesod.Auth.DeskCom.Data where++import Control.Applicative ((<$>))+import Yesod.Core+import qualified Crypto.Random.AESCtr as CPRNG+import qualified Data.IORef as I++-- | Data type for @yesod-auth-deskCom@\'s subsite.+data DeskCom = DeskCom { deskComCprngVar :: I.IORef CPRNG.AESRNG }+++-- | Initialize the 'DeskCom' subsite with a fresh CPRNG.+initDeskCom :: IO DeskCom+initDeskCom = DeskCom <$> (I.newIORef =<< CPRNG.makeSystem)+++mkYesodSubData "DeskCom" [parseRoutes|+ / DeskComLoginR GET+ /m DeskComMaybeLoginR GET+|]
yesod-auth-deskcom.cabal view
@@ -1,5 +1,5 @@ Name: yesod-auth-deskcom-Version: 1.1+Version: 1.2 Synopsis: Desk.com remote authentication support for Yesod apps. Homepage: https://github.com/meteficha/yesod-auth-deskcom License: BSD3@@ -30,25 +30,30 @@ Library hs-source-dirs: src - Build-depends: base >= 4.3 && < 5- , time >= 1.1 && < 2+ Build-depends: base >= 4.3 && < 5+ , time >= 1.1 && < 2 , template-haskell- , transformers >= 0.1.3 && < 0.4- , bytestring >= 0.9- , text >= 0.7 && < 0.12+ , transformers >= 0.1.3 && < 0.4+ , bytestring >= 0.9+ , text >= 0.7 && < 0.12 , data-default- , base64-bytestring >= 1.0- , cryptohash >= 0.6- , cipher-aes >= 0.1- , crypto-api >= 0.10- , aeson >= 0.6+ , base64-bytestring >= 1.0+ , cryptohash >= 0.6+ , cryptohash-cryptoapi >= 0.1+ , cipher-aes >= 0.1+ , cprng-aes >= 0.3+ , crypto-api >= 0.10+ , aeson >= 0.6 , http-conduit- , http-types >= 0.7- , yesod-core == 1.1.*- , yesod-auth == 1.1.*+ , http-types >= 0.7+ , yesod-core == 1.2.*+ , yesod-auth == 1.2.* Exposed-modules: Yesod.Auth.DeskCom+ Other-modules: Yesod.Auth.DeskCom.Data Extensions:+ ConstraintKinds+ FlexibleContexts FlexibleInstances GADTs MultiParamTypeClasses