diff --git a/servant-foreign/servant-foreign.cabal b/servant-foreign/servant-foreign.cabal index 90ebe8bb..372a5081 100644 --- a/servant-foreign/servant-foreign.cabal +++ b/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 \ No newline at end of file + ghc-options: -Wall diff --git a/servant-foreign/src/Servant/Foreign.hs b/servant-foreign/src/Servant/Foreign.hs index 6cd72b84..2c4f9dec 100644 --- a/servant-foreign/src/Servant/Foreign.hs +++ b/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 diff --git a/servant-js/src/Servant/JS/Internal.hs b/servant-js/src/Servant/JS/Internal.hs index a7af966b..473c72a9 100644 --- a/servant-js/src/Servant/JS/Internal.hs +++ b/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