aboutsummaryrefslogtreecommitdiff
path: root/lib/Yesod
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lib/Yesod/Auth/Uffd.hs73
1 files changed, 73 insertions, 0 deletions
diff --git a/lib/Yesod/Auth/Uffd.hs b/lib/Yesod/Auth/Uffd.hs
new file mode 100644
index 0000000..4d5e5af
--- /dev/null
+++ b/lib/Yesod/Auth/Uffd.hs
@@ -0,0 +1,73 @@
+{-# 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
+ }