aboutsummaryrefslogtreecommitdiff
path: root/src/Sproxy/Application
diff options
context:
space:
mode:
Diffstat (limited to 'src/Sproxy/Application')
-rw-r--r--src/Sproxy/Application/Access.hs18
-rw-r--r--src/Sproxy/Application/Cookie.hs72
-rw-r--r--src/Sproxy/Application/OAuth2/Common.hs45
-rw-r--r--src/Sproxy/Application/State.hs25
4 files changed, 75 insertions, 85 deletions
diff --git a/src/Sproxy/Application/Access.hs b/src/Sproxy/Application/Access.hs
index d8984ee..6ba972c 100644
--- a/src/Sproxy/Application/Access.hs
+++ b/src/Sproxy/Application/Access.hs
@@ -1,23 +1,21 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
-module Sproxy.Application.Access (
- Inquiry
-, Question(..)
-) where
+module Sproxy.Application.Access
+ ( Inquiry
+ , Question(..)
+ ) where
import Data.Aeson (FromJSON)
import Data.HashMap.Strict (HashMap)
import Data.Text (Text)
import GHC.Generics (Generic)
-
-data Question = Question {
- path :: Text
-, method :: Text
-} deriving (Generic, Show)
+data Question = Question
+ { path :: Text
+ , method :: Text
+ } deriving (Generic, Show)
instance FromJSON Question
type Inquiry = HashMap Text Question
-
diff --git a/src/Sproxy/Application/Cookie.hs b/src/Sproxy/Application/Cookie.hs
index a86f42a..a9a8ad6 100644
--- a/src/Sproxy/Application/Cookie.hs
+++ b/src/Sproxy/Application/Cookie.hs
@@ -1,56 +1,57 @@
{-# LANGUAGE OverloadedStrings #-}
-module Sproxy.Application.Cookie (
- AuthCookie(..)
-, AuthUser
-, cookieDecode
-, cookieEncode
-, getEmail
-, getEmailUtf8
-, getFamilyNameUtf8
-, getGivenNameUtf8
-, newUser
-, setFamilyName
-, setGivenName
-) where
+
+module Sproxy.Application.Cookie
+ ( AuthCookie(..)
+ , AuthUser
+ , cookieDecode
+ , cookieEncode
+ , getEmail
+ , getEmailUtf8
+ , getFamilyNameUtf8
+ , getGivenNameUtf8
+ , newUser
+ , setFamilyName
+ , setGivenName
+ ) where
import Data.ByteString (ByteString)
-import Data.Text (Text, toLower, strip)
+import qualified Data.Serialize as DS
+import Data.Text (Text, strip, toLower)
import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Foreign.C.Types (CTime(..))
-import qualified Data.Serialize as DS
import qualified Sproxy.Application.State as State
-data AuthUser = AuthUser {
- auEmail :: ByteString
-, auGivenName :: ByteString
-, auFamilyName :: ByteString
-}
+data AuthUser = AuthUser
+ { auEmail :: ByteString
+ , auGivenName :: ByteString
+ , auFamilyName :: ByteString
+ }
-data AuthCookie = AuthCookie {
- acUser :: AuthUser
-, acExpiry :: CTime
-}
+data AuthCookie = AuthCookie
+ { acUser :: AuthUser
+ , acExpiry :: CTime
+ }
instance DS.Serialize AuthCookie where
put c = DS.put (auEmail u, auGivenName u, auFamilyName u, x)
- where u = acUser c
- x = (\(CTime i) -> i) $ acExpiry c
+ where
+ u = acUser c
+ x = (\(CTime i) -> i) $ acExpiry c
get = do
(e, n, f, x) <- DS.get
- return AuthCookie {
- acUser = AuthUser { auEmail = e, auGivenName = n, auFamilyName = f }
+ return
+ AuthCookie
+ { acUser = AuthUser {auEmail = e, auGivenName = n, auFamilyName = f}
, acExpiry = CTime x
}
-
cookieDecode :: ByteString -> ByteString -> Either String AuthCookie
cookieDecode key d = State.decode key d >>= DS.decode
cookieEncode :: ByteString -> AuthCookie -> ByteString
cookieEncode key = State.encode key . DS.encode
-
getEmail :: AuthUser -> Text
getEmail = decodeUtf8 . auEmail
@@ -63,17 +64,16 @@ getGivenNameUtf8 = auGivenName
getFamilyNameUtf8 :: AuthUser -> ByteString
getFamilyNameUtf8 = auFamilyName
-
newUser :: Text -> AuthUser
-newUser email = AuthUser {
- auEmail = encodeUtf8 . toLower . strip $ email
+newUser email =
+ AuthUser
+ { auEmail = encodeUtf8 . toLower . strip $ email
, auGivenName = ""
, auFamilyName = ""
}
setGivenName :: Text -> AuthUser -> AuthUser
-setGivenName given au = au{ auGivenName = encodeUtf8 . strip $ given }
+setGivenName given au = au {auGivenName = encodeUtf8 . strip $ given}
setFamilyName :: Text -> AuthUser -> AuthUser
-setFamilyName family au = au{ auFamilyName = encodeUtf8 . strip $ family }
-
+setFamilyName family au = au {auFamilyName = encodeUtf8 . strip $ family}
diff --git a/src/Sproxy/Application/OAuth2/Common.hs b/src/Sproxy/Application/OAuth2/Common.hs
index 0324e62..ae96e68 100644
--- a/src/Sproxy/Application/OAuth2/Common.hs
+++ b/src/Sproxy/Application/OAuth2/Common.hs
@@ -1,40 +1,37 @@
{-# LANGUAGE OverloadedStrings #-}
-module Sproxy.Application.OAuth2.Common (
- AccessTokenBody(..)
-, OAuth2Client(..)
-, OAuth2Provider
-) where
+
+module Sproxy.Application.OAuth2.Common
+ ( AccessTokenBody(..)
+ , OAuth2Client(..)
+ , OAuth2Provider
+ ) where
import Control.Applicative (empty)
-import Data.Aeson (FromJSON, parseJSON, Value(Object), (.:))
-import Data.ByteString(ByteString)
+import Data.Aeson (FromJSON, Value(Object), (.:), parseJSON)
+import Data.ByteString (ByteString)
import Data.Text (Text)
import Sproxy.Application.Cookie (AuthUser)
-data OAuth2Client = OAuth2Client {
- oauth2Description :: String
-, oauth2AuthorizeURL
- :: ByteString -- state
- -> ByteString -- redirect url
- -> ByteString
-, oauth2Authenticate
- :: ByteString -- code
- -> ByteString -- redirect url
- -> IO AuthUser
-}
+data OAuth2Client = OAuth2Client
+ { oauth2Description :: String
+ , oauth2AuthorizeURL :: ByteString -- state
+ -> ByteString -- redirect url
+ -> ByteString
+ , oauth2Authenticate :: ByteString -- code
+ -> ByteString -- redirect url
+ -> IO AuthUser
+ }
type OAuth2Provider = (ByteString, ByteString) -> OAuth2Client
-- | RFC6749. We ignore optional token_type ("Bearer" from Google, omitted by LinkedIn)
-- and expires_in because we don't use them, *and* expires_in creates troubles:
-- it's an integer from Google and string from LinkedIn (sic!)
-data AccessTokenBody = AccessTokenBody {
- accessToken :: Text
-} deriving (Eq, Show)
+data AccessTokenBody = AccessTokenBody
+ { accessToken :: Text
+ } deriving (Eq, Show)
instance FromJSON AccessTokenBody where
- parseJSON (Object v) = AccessTokenBody
- <$> v .: "access_token"
+ parseJSON (Object v) = AccessTokenBody <$> v .: "access_token"
parseJSON _ = empty
-
diff --git a/src/Sproxy/Application/State.hs b/src/Sproxy/Application/State.hs
index 29d9252..5f836e6 100644
--- a/src/Sproxy/Application/State.hs
+++ b/src/Sproxy/Application/State.hs
@@ -1,30 +1,25 @@
-module Sproxy.Application.State (
- decode
-, encode
-) where
+module Sproxy.Application.State
+ ( decode
+ , encode
+ ) where
import Data.ByteString (ByteString)
-import Data.ByteString.Lazy (fromStrict, toStrict)
-import Data.Digest.Pure.SHA (hmacSha1, bytestringDigest)
import qualified Data.ByteString.Base64 as Base64
+import Data.ByteString.Lazy (fromStrict, toStrict)
+import Data.Digest.Pure.SHA (bytestringDigest, hmacSha1)
import qualified Data.Serialize as DS
-
-- FIXME: Compress / decompress ?
-
-
encode :: ByteString -> ByteString -> ByteString
encode key payload = Base64.encode . DS.encode $ (payload, digest key payload)
-
decode :: ByteString -> ByteString -> Either String ByteString
decode key d = do
(payload, dgst) <- DS.decode =<< Base64.decode d
if dgst /= digest key payload
- then Left "junk"
- else Right payload
-
+ then Left "junk"
+ else Right payload
digest :: ByteString -> ByteString -> ByteString
-digest key payload = toStrict . bytestringDigest $ hmacSha1 (fromStrict key) (fromStrict payload)
-
+digest key payload =
+ toStrict . bytestringDigest $ hmacSha1 (fromStrict key) (fromStrict payload)
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-29 09:47:40 +0000