Add support for authentication to servant-foreign and servant-js

servant-foreign/servant-foreign.cabal

@@ -29,6 +29,7 @@ library
   build-depends:       base    == 4.*
                      , lens    == 4.*
                      , servant == 0.5.*
+                     , text            >= 1.2  && < 1.3
   hs-source-dirs:      src
   default-language:    Haskell2010
   ghc-options:         -Wall

servant-foreign/src/Servant/Foreign.hs

@@ -54,10 +54,11 @@ import           Control.Lens                  (makeLenses, (%~), (&), (.~),
 import Data.Char (toLower, toUpper)
 import Data.List
 import Data.Proxy
+import Data.Text (Text)
 import GHC.Exts (Constraint)
 import GHC.TypeLits
 import Servant.API
-
+import Servant.API.Authentication
 -- | Function name builder that simply concat each part together
 concatCase :: FunctionName -> String
 concatCase = concat
@@ -105,7 +106,11 @@ data HeaderArg = HeaderArg
   | ReplaceHeaderArg
     { headerArgName :: String
     , headerPattern :: String
-    } deriving (Eq, Show)
+    }
+  | HeaderArgGen
+    { headerArgName    :: String
+    , headerArgGenBody :: (String -> String)
+    }
 
 
 type MatrixArg = QueryArg
@@ -127,7 +132,7 @@ data Req = Req
   , _reqHeaders :: [HeaderArg]
   , _reqBody    :: Bool
   , _funcName   :: FunctionName
-  } deriving (Eq, Show)
+  }
 
 makeLenses ''QueryArg
 makeLenses ''Segment
@@ -201,6 +206,30 @@ instance (KnownSymbol sym, HasForeign sublayout)
     where hname = symbolVal (Proxy :: Proxy sym)
           subP = Proxy :: Proxy sublayout
 
+instance (HasForeign sublayout)
+      => HasForeign (AuthProtect (BasicAuth realm) (usr :: *) (policy :: AuthPolicy) :> sublayout) where
+  type Foreign (AuthProtect (BasicAuth realm) (usr :: *) (policy :: AuthPolicy) :> sublayout) = Foreign sublayout
+
+  foreignFor Proxy req =
+    foreignFor (Proxy :: Proxy sublayout) (req & reqHeaders <>~
+      [HeaderArgGen "Authorization" $ \authdata ->
+        "(function("++authdata++"){" ++
+        "return \"Basic \" + btoa("++authdata++".username+\":\"+"++authdata ++ ".password)" ++
+        "})("++authdata++")"
+      ])
+  
+instance (HasForeign sublayout)
+      => HasForeign (AuthProtect Text (usr :: *) (policy :: AuthPolicy) :> sublayout) where
+  type Foreign (AuthProtect Text (usr :: *) (policy :: AuthPolicy) :> sublayout) = Foreign sublayout
+
+  foreignFor Proxy req =
+    foreignFor (Proxy :: Proxy sublayout) (req & reqHeaders <>~
+      [HeaderArgGen "Authorization" $ \authdata ->
+        "(function("++authdata++"){" ++
+        "return \"Bearer \" + "++authdata++";"++
+        "})("++authdata++")"
+      ])
+
 instance Elem JSON list => HasForeign (Post list a) where
   type Foreign (Post list a) = Req
 

servant-js/src/Servant/JS/Internal.hs

@@ -111,6 +111,7 @@ toValidFunctionName [] = "_"
 
 toJSHeader :: HeaderArg -> String
 toJSHeader (HeaderArg n)          = toValidFunctionName ("header" <> n)
+toJSHeader (HeaderArgGen n b)     = b (toJSHeader (HeaderArg n))
 toJSHeader (ReplaceHeaderArg n p)
   | pn `isPrefixOf` p = pv <> " + \"" <> rp <> "\""
   | pn `isSuffixOf` p = "\"" <> rp <> "\" + " <> pv