summaryrefslogtreecommitdiff
path: root/Auth/Proxied.hs
blob: 15f5808957e726295f3640a5623fcd2df12dca32 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE OverloadedStrings #-}

module Auth.Proxied
    ( authProxied
    ) where

import Yesod.Auth
import Yesod.Core (lift)
import Yesod.Core.Handler (notFound, waiRequest)
import Text.Hamlet (hamlet)
import Yesod.Core.Widget (toWidget)

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
        lift $ setCreds True $ Creds "proxied" (fromMaybe "" mfu) []
    dispatch _ _ = notFound
    login authToMaster =
        let url = authToMaster (PluginR "proxied" []) in
        toWidget [hamlet|
    Your are now authenticated for #
    <a href="@{url}">here
|]