Make sure all HTTP headers are UTF8-encoded

Especially X-Family-Name, X-Given-Name.
Since we get all the data from JSON and JSON is in UTF8
by default RFC 7159, we are safe.

Refactored to make it less error-prone and to get
as small number of encoding/decoding as possible.

1 files changed, 40 insertions, 5 deletions

diff --git a/src/Sproxy/Application/Cookie.hs b/src/Sproxy/Application/Cookie.hs
index 07cc162..a86f42a 100644
--- a/src/Sproxy/Application/Cookie.hs
+++ b/src/Sproxy/Application/Cookie.hs
@@ -1,20 +1,30 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Sproxy.Application.Cookie (
   AuthCookie(..)
-, AuthUser(..)
+, AuthUser
 , cookieDecode
 , cookieEncode
+, getEmail
+, getEmailUtf8
+, getFamilyNameUtf8
+, getGivenNameUtf8
+, newUser
+, setFamilyName
+, setGivenName
 ) where
 
 import Data.ByteString (ByteString)
+import Data.Text (Text, toLower, strip)
+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      :: String
-, auGivenName  :: String
-, auFamilyName :: String
+  auEmail      :: ByteString
+, auGivenName  :: ByteString
+, auFamilyName :: ByteString
 }
 
 data AuthCookie = AuthCookie {
@@ -37,8 +47,33 @@ instance DS.Serialize AuthCookie where
 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
+
+getEmailUtf8 :: AuthUser -> ByteString
+getEmailUtf8 = auEmail
+
+getGivenNameUtf8 :: AuthUser -> ByteString
+getGivenNameUtf8 = auGivenName
+
+getFamilyNameUtf8 :: AuthUser -> ByteString
+getFamilyNameUtf8 = auFamilyName
+
+
+newUser :: Text -> AuthUser
+newUser email = AuthUser {
+    auEmail = encodeUtf8 . toLower . strip $ email
+  , auGivenName = ""
+  , auFamilyName = ""
+  }
+
+setGivenName :: Text -> AuthUser -> AuthUser
+setGivenName given au = au{ auGivenName = encodeUtf8 . strip $ given }
+
+setFamilyName :: Text -> AuthUser -> AuthUser
+setFamilyName family au = au{ auFamilyName = encodeUtf8 . strip $ family }
+