{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Main (main) where
import Data.Binary (encode, decodeOrFail)
import qualified Data.ByteString.Lazy.Char8 as BSL8
import qualified Data.Text as T
import Hedgehog
import Hedgehog.Gen as Gen
import Hedgehog.Range as Range
import Network.Wai.Auth.Internal
import qualified Network.OAuth.OAuth2.Internal as OA2
main :: IO Bool
main =
checkParallel $ Group "Main" [
("oAuth2TokenBinaryDuality", oAuth2TokenBinaryDuality)
]
oAuth2TokenBinaryDuality :: Property
oAuth2TokenBinaryDuality = property $ do
token <- forAll oauth2TokenBinary
let checkUnconsumed ("", _, roundTripToken) = roundTripToken
checkUnconsumed (unconsumed, _, _) =
error $ "Unexpected unconsumed in bytes: " <> BSL8.unpack unconsumed
tripping token encode (fmap checkUnconsumed . decodeOrFail)
tripping token (encodeToken . unOAuth2TokenBinary) (fmap OAuth2TokenBinary . decodeToken)
oauth2TokenBinary :: Gen OAuth2TokenBinary
oauth2TokenBinary = do
accessToken <- OA2.AccessToken <$> anyText
refreshToken <- Gen.maybe $ OA2.RefreshToken <$> anyText
expiresIn <- Gen.maybe $ Gen.int (Range.linear 0 1000)
tokenType <- Gen.maybe anyText
idToken <- Gen.maybe $ OA2.IdToken <$> anyText
pure $
OAuth2TokenBinary $
OA2.OAuth2Token accessToken refreshToken expiresIn tokenType idToken
anyText :: Gen T.Text
anyText = Gen.text (Range.linear 0 100) Gen.unicodeAll
-- The `OAuth2Token` type from the `hoauth2` library does not have a `Eq`
-- instance, and it's constituent parts don't have a `Generic` instance. Hence
-- this orphan instance here.
instance Eq OAuth2TokenBinary where
(OAuth2TokenBinary t1) == (OAuth2TokenBinary t2) =
and
[ OA2.atoken (OA2.accessToken t1) == OA2.atoken (OA2.accessToken t2)
, (OA2.rtoken <$> OA2.refreshToken t1) == (OA2.rtoken <$> OA2.refreshToken t2)
, OA2.expiresIn t1 == OA2.expiresIn t2
, OA2.tokenType t1 == OA2.tokenType t2
, (OA2.idtoken <$> OA2.idToken t1) == (OA2.idtoken <$> OA2.idToken t2)
]