diff --git a/fb.cabal b/fb.cabal --- a/fb.cabal +++ b/fb.cabal @@ -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 diff --git a/src/Facebook.hs b/src/Facebook.hs --- a/src/Facebook.hs +++ b/src/Facebook.hs @@ -29,6 +29,8 @@ , getUserAccessTokenStep2 , getUserLogoutUrl , extendUserAccessToken + -- ** Signed requests + , parseSignedRequest -- * Facebook's Graph API Objects -- ** User diff --git a/src/Facebook/Auth.hs b/src/Facebook/Auth.hs --- a/src/Facebook/Auth.hs +++ b/src/Facebook/Auth.hs @@ -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 +-- (), +-- 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 diff --git a/tests/runtests.hs b/tests/runtests.hs --- a/tests/runtests.hs +++ b/tests/runtests.hs @@ -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