{-# LANGUAGE RecordWildCards #-} module Yesod.Auth.Uffd (uffdClient, UffdUser(..)) where import Control.Monad.IO.Class (liftIO) import Data.Aeson ((.=)) import qualified Data.Aeson as A import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C8 import Data.ByteString.Lazy (fromStrict, toStrict) import qualified Data.Text as T import Data.Text.Encoding (decodeUtf8) import URI.ByteString (Absolute, URIRef (..)) import Yesod.Auth import Yesod.Auth.OAuth2.Prelude import Yesod.Core (PathPiece (..)) import Yesod.Core.Handler (setSession) data UffdUser = UffdUser { uffdId :: Int , uffdName :: Text , uffdDisplayName :: Text , uffdEmail :: Text , uffdGroups :: [Text] } deriving (Show) instance PathPiece UffdUser where fromPathPiece = A.decode . fromStrict . C8.pack . T.unpack toPathPiece = decodeUtf8 . toStrict . A.encode instance FromJSON UffdUser where parseJSON = withObject "User" $ \o -> UffdUser <$> o .: "id" <*> o .: "nickname" <*> o .: "name" <*> o .: "email" <*> o .: "groups" instance ToJSON UffdUser where toJSON UffdUser {..} = A.object [ "id" .= uffdId , "nickname" .= uffdName , "name" .= uffdDisplayName , "email" .= uffdEmail , "groups" .= uffdGroups ] pluginName = "uffd" uffdClient :: YesodAuth m => URIRef Absolute -> Text -> Text -> AuthPlugin m uffdClient url clientId clientSecret = authOAuth2 "uffd" oauth2 $ \manager token -> do resp@(user@UffdUser {..}, userResponse) <- authGetProfile "uffd" manager token (url { uriPath = "/oauth2/userinfo" }) pure Creds { credsPlugin = "uffd" , credsIdent = T.pack $ show uffdId , credsExtra = [ ("json", decodeUtf8 $ toStrict (A.encode user)) ] -- just dump the entire extra thing into the session, so we can reconstruct it later } where oauth2 = OAuth2 { oauth2ClientId = clientId , oauth2ClientSecret = Just clientSecret , oauth2AuthorizeEndpoint = url { uriPath = "/oauth2/authorize" } , oauth2TokenEndpoint = url { uriPath = "/oauth2/token" } , oauth2RedirectUri = Nothing }