redefined token endpoint

src/Server.hs

@@ -23,6 +23,7 @@ import Data.Maybe (fromMaybe)
 import Data.String (IsString (..))
 import Data.Text hiding (elem, find, head, length, map, null, splitAt, tail, words)
 import Data.Text.Encoding (decodeUtf8)
+import Data.Time.Clock (NominalDiffTime (..), nominalDay)
 
 import qualified Data.Map.Strict as Map
 
@@ -71,7 +72,6 @@ type Auth user userData = BasicAuth "login" user
                        :> QParam "redirect_uri" QRedirect
                        :> Get '[JSON] userData
 
-type Token = "token" :> Post '[JSON] Text -- TODO post jwt token
 -- type Insert = "insert" :> Post '[JSON] User
 
 
@@ -103,7 +103,7 @@ authServer = handleAuth
       -- return uData
       redirect $ url `withCode` mAuthCode
     redirect :: Maybe ByteString -> AuthHandler userData
-    redirect (Just url) = throwError err302 { errHeaders = [("Location", url)]}
+    redirect (Just url) = throwError err303 { errHeaders = [("Location", url)]}
     redirect Nothing = throwError err500 { errBody = "Could not generate authorisation code."}
     withCode :: String -> Maybe String -> Maybe ByteString
     withCode url Nothing = Nothing
@@ -152,8 +152,45 @@ runMockServer' port = do
   bracket (forkIO . run port $ insecureOAuthMock' testUsers state) killThread $ \_ ->
     runClientM (frontend $ BasicAuthData "foo@bar.com" "0000") (mkClientEnv mgr (BaseUrl Http "localhost" port ""))
       >>= print
-  
 
-tokenEndpoint :: Server Token
-tokenEndpoint = undefined
+
+------
+------ Token
+------
+
+
+data ClientData = ClientData
+  { grantType :: Text
+  , grant :: Text
+  , clientID :: Text
+  , clientSecret :: Text
+  , redirect :: Text
+  } deriving Show
+
+instance FromJSON ClientData where
+  parseJSON (Object o) = ClientData
+    <$> o .: "grant_type"
+    <*> o .: "authorization_code" --TODO add alternatives
+    <*> o .: "client_id"
+    <*> o .: "client_secret"
+    <*> o .: "redirect_url"
+
+data JWT = JWT
+  { token :: Text -- TODO should be JWT
+  , tokenType :: Text -- TODO enum
+  , expiration :: NominalDiffTime
+  }
+
+type Token = "token"
+          :> ReqBody '[JSON] ClientData
+          :> Post '[JSON] JWT
+
+tokenEndpoint :: AuthServer Token
+tokenEndpoint = provideToken
+  where
+    provideToken :: ClientData -> AuthHandler JWT
+    provideToken client = do
+      --TODO validate everything
+      return JWT {token = "", tokenType = "JWT", expiration = 0.25 * nominalDay}
+