fb 0.9.3 → 0.9.4
raw patch · 4 files changed
+80/−8 lines, 4 filesdep +base64-bytestringdep +cerealdep +crypto-apiPVP ok
version bump matches the API change (PVP)
Dependencies added: base64-bytestring, cereal, crypto-api, cryptohash
API changes (from Hackage documentation)
+ Facebook: parseSignedRequest :: (FromJSON a, Monad m) => ByteString -> FacebookT Auth m (Maybe a)
Files
- fb.cabal +5/−1
- src/Facebook.hs +2/−0
- src/Facebook/Auth.hs +51/−3
- tests/runtests.hs +22/−4
fb.cabal view
@@ -1,5 +1,5 @@ name: fb-version: 0.9.3+version: 0.9.4 license: BSD3 license-file: LICENSE author: Felipe Lessa@@ -67,8 +67,12 @@ , attoparsec >= 0.10 && < 0.11 , attoparsec-conduit >= 0.4 && < 0.5 , aeson >= 0.5 && < 0.7+ , base64-bytestring >= 0.1.1 && < 0.2 , time >= 1.2 && < 1.5 , old-locale+ , cereal == 0.3.*+ , crypto-api == 0.10.*+ , cryptohash == 0.7.* extensions: DeriveDataTypeable EmptyDataDecls
src/Facebook.hs view
@@ -29,6 +29,8 @@ , getUserAccessTokenStep2 , getUserLogoutUrl , extendUserAccessToken+ -- ** Signed requests+ , parseSignedRequest -- * Facebook's Graph API Objects -- ** User
src/Facebook/Auth.hs view
@@ -9,26 +9,35 @@ , Permission , hasExpired , isValid+ , parseSignedRequest ) where import Control.Applicative-import Control.Monad (join)+import Control.Monad (guard, join, liftM, mzero) import Control.Monad.IO.Class (MonadIO(liftIO)) import Control.Monad.Trans.Control (MonadBaseControl)+import Control.Monad.Trans.Maybe (MaybeT(..))+import Crypto.Classes (constTimeEq)+import Crypto.Hash.SHA256 (SHA256)+import Crypto.HMAC (hmac', MacKey(..)) import Data.Aeson ((.:))-import Data.Aeson.Types (parseEither)+import Data.Aeson.Parser (json') import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Time (getCurrentTime, addUTCTime, UTCTime) import Data.String (IsString(..)) import qualified Control.Exception.Lifted as E+import qualified Data.Aeson as AE+import qualified Data.Aeson.Types as AE import qualified Data.Attoparsec.Char8 as A import qualified Data.ByteString as B+import qualified Data.ByteString.Base64 as Base64 import qualified Data.ByteString.Char8 as B8 import qualified Data.Conduit as C import qualified Data.Conduit.Attoparsec as C import qualified Data.List as L+import qualified Data.Serialize as Cereal import qualified Data.Text as T import qualified Data.Text.Encoding as TE import qualified Data.Text.Encoding.Error as TE@@ -105,7 +114,7 @@ -- Get user's ID throught Facebook's graph. userInfo <- asJson =<< fbhttp =<< fbreq "/me" (Just preToken) [("fields", "id")]- case (parseEither (.: "id") userInfo, preToken) of+ case (AE.parseEither (.: "id") userInfo, preToken) of (Left str, _) -> E.throw $ FbLibraryException $ T.concat [ "getUserAccessTokenStep2: failed to get the UserId ("@@ -270,3 +279,42 @@ mkExc [ "the user access token has already expired, " , "so I'll not try to extend it." ] mkExc = FbLibraryException . T.concat . ("extendUserAccessToken: ":)+++-- | Parses a Facebook signed request+-- (<https://developers.facebook.com/docs/authentication/signed_request/>),+-- verifies its authencity and integrity using the HMAC and+-- decodes its JSON object.+parseSignedRequest :: (AE.FromJSON a, Monad m) =>+ B8.ByteString -- ^ Encoded Facebook signed request+ -> FacebookT Auth m (Maybe a)+parseSignedRequest signedRequest =+ runMaybeT $ do+ -- Split, decode and JSON-parse+ let (encodedSignature, encodedUnparsedPayloadWithDot) = B8.break (== '.') signedRequest+ ('.', encodedUnparsedPayload) <- MaybeT $ return (B8.uncons encodedUnparsedPayloadWithDot)+ let signature = Base64.decodeLenient encodedSignature+ unparsedPayload = Base64.decodeLenient encodedUnparsedPayload+ payload <- eitherToMaybeT $ A.parseOnly json' unparsedPayload++ -- Verify signature+ SignedRequestAlgorithm algo <- fromJson payload+ guard (algo == "HMAC-SHA256")+ hmacKey <- credsToHmacKey `liftM` lift getCreds+ let expectedSignature = Cereal.encode $ hmac' hmacKey encodedUnparsedPayload+ guard (signature `constTimeEq` expectedSignature)++ -- Parse user data type+ fromJson payload++ where eitherToMaybeT :: Monad m => Either a b -> MaybeT m b+ eitherToMaybeT = MaybeT . return . either (const Nothing) Just+ fromJson :: (AE.FromJSON a, Monad m) => AE.Value -> MaybeT m a+ fromJson = eitherToMaybeT . AE.parseEither AE.parseJSON+ credsToHmacKey :: Credentials -> MacKey ctx SHA256+ credsToHmacKey = MacKey . appSecret++newtype SignedRequestAlgorithm = SignedRequestAlgorithm Text+instance AE.FromJSON SignedRequestAlgorithm where+ parseJSON (AE.Object v) = SignedRequestAlgorithm <$> v .: "algorithm"+ parseJSON _ = mzero
tests/runtests.hs view
@@ -92,7 +92,7 @@ (C.runResourceT . FB.beta_runNoAuthFacebookT manager) -- Tests that don't depend on which tier is chosen.- libraryTests+ libraryTests manager facebookTests :: String -> H.Manager@@ -156,9 +156,9 @@ Nothing -> liftIO $ assertFailure "Could not parse FQL query response." Just r' -> r' &?= ("Facebook" :: Text) - -libraryTests :: Specs-libraryTests = do++libraryTests :: H.Manager -> Specs+libraryTests manager = do describe "SimpleType" $ do it "works for Bool" $ (map FB.encodeFbParam [True, False]) @?= ["1", "0"] @@ -205,6 +205,24 @@ toId = FB.Id . B.pack . show j = abs i in FB.encodeFbParam (toId j) == FB.encodeFbParam j++ describe "parseSignedRequest" $ do+ let exampleSig, exampleData :: B.ByteString+ exampleSig = "vlXgu64BQGFSQrY0ZcJBZASMvYvTHu9GQ0YM9rjPSso"+ exampleData = "eyJhbGdvcml0aG0iOiJITUFDLVNIQTI1NiIsIjAiOiJwYXlsb2FkIn0"+ exampleCreds = FB.Credentials "name" "id" "secret"+ runExampleAuth :: FB.FacebookT FB.Auth (C.ResourceT IO) a -> IO a+ runExampleAuth = C.runResourceT . FB.runFacebookT exampleCreds manager+ it "works for Facebook example" $ do+ runExampleAuth $ do+ ret <- FB.parseSignedRequest (B.concat [exampleSig, ".", exampleData])+ ret &?= Just (A.object [ "algorithm" A..= ("HMAC-SHA256" :: Text)+ , "0" A..= ("payload" :: Text)])+ it "fails to parse the Facebook example when signature is corrupted" $ do+ let corruptedSig = B.cons 'a' (B.tail exampleSig)+ runExampleAuth $ do+ ret <- FB.parseSignedRequest (B.concat [corruptedSig, ".", exampleData])+ ret &?= (Nothing :: Maybe A.Value) -- Wrappers for HUnit operators using MonadIO