summaryrefslogtreecommitdiff
path: root/Auth/Proxied.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Auth/Proxied.hs')
-rw-r--r--Auth/Proxied.hs37
1 files changed, 37 insertions, 0 deletions
diff --git a/Auth/Proxied.hs b/Auth/Proxied.hs
new file mode 100644
index 0000000..684a3a1
--- /dev/null
+++ b/Auth/Proxied.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Auth.Proxied
+ ( authProxied
+ ) where
+
+import Yesod.Auth
+import Yesod.Handler (notFound)
+import Text.Hamlet (hamlet)
+import Yesod.Widget (toWidget)
+
+import Yesod.Handler (waiRequest)
+import Data.List (lookup)
+import Data.Maybe (fromMaybe)
+import Network.Wai (Request(requestHeaders))
+import Prelude (($), (.), Bool(..), fmap, either, const, Maybe(..), (/=), (=<<), return, show)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Base64 as Base64
+import Data.CaseInsensitive (mk)
+import Data.Text.Encoding (decodeUtf8)
+
+
+authProxied :: YesodAuth m => AuthPlugin m
+authProxied =
+ AuthPlugin "proxied" dispatch login
+ where
+ dispatch _ [] = do
+ mfu <- fmap ((fmap (decodeUtf8 . B.takeWhile (58 /=)) . either (const Nothing) return . Base64.decode . B.drop 1 . B.dropWhile (32 /=) =<<) . lookup (mk "Authorization") . requestHeaders) waiRequest
+ setCreds True $ Creds "proxied" (fromMaybe "" mfu) []
+ dispatch _ _ = notFound
+ login authToMaster =
+ let url = authToMaster (PluginR "proxied" []) in
+ toWidget [hamlet|
+ Your new identifier is: #
+ <a href="@{url}">Zoinkz
+|]