Add login function

src/Lisa/Squeak.hs

@@ -5,15 +5,29 @@ module Lisa.Squeak where
 import Data.Aeson (FromJSON(parseJSON), ToJSON(toJSON), Value, (.:), (.:?), (.=), object, withObject)
 import Data.Text (Text)
 import Data.Time.Calendar (Day)
-import Network.HTTP.Req (POST(..), ReqBodyJson(..), Req, https, jsonResponse, responseBody, req)
+import Network.HTTP.Req (POST(..), ReqBodyJson(..), Req, http, https, port, jsonResponse, responseBody, req)
 
 data GQLQuery = GQLQuery
-    { gqlQueryQuery :: Text
+    { gqlQueryQuery     :: Text
     }
     deriving (Show)
 
 instance ToJSON GQLQuery where
-    toJSON (GQLQuery q) = object ["query" .= q]
+    toJSON (GQLQuery query) = object
+        [ "query" .= query
+        ]
+
+data GQLQueryWithVars a = GQLQueryWithVars
+    { gqlQueryWithVarsQuery     :: Text
+    , gqlQueryWithVarsVariables :: a
+    }
+    deriving (Show)
+
+instance ToJSON a => ToJSON (GQLQueryWithVars a) where
+    toJSON (GQLQueryWithVars query variables) = object
+        [ "query" .= query
+        , "variables" .= variables
+        ]
 
 data GQLReply a = GQLReply
     { gqlReplyData :: Maybe a
@@ -26,6 +40,11 @@ instance FromJSON a => FromJSON (GQLReply a) where
         <$> v .: "data"
         <*> v .:? "errors"
 
+replyToEither :: GQLReply a -> Either [GQLError] a
+replyToEither (GQLReply (Just data') _)  = Right data'
+replyToEither (GQLReply _ (Just errors)) = Left errors
+replyToEither _                          = error "Invalid GQLReply: Neither 'data' nor 'errors'"
+
 data GQLError = GQLError
     { gqlErrorMessage :: Text
     }
@@ -96,10 +115,47 @@ instance FromJSON Lecture where
 
 serverUrl = https "api.squeak-test.fsmi.uni-karlsruhe.de"
 
-getLectures :: Req (GQLReply Lectures)
-getLectures = responseBody <$> req POST serverUrl (ReqBodyJson $ GQLQuery q) jsonResponse mempty
+getAllLectures :: Req (Either [GQLError] [Lecture])
+getAllLectures = fmap unLectures <$> replyToEither <$> responseBody <$> req POST serverUrl (ReqBodyJson $ GQLQuery q) jsonResponse mempty
     where q = "{ lectures { id displayName aliases } }"
 
-getDocuments :: Req (GQLReply Documents)
-getDocuments = responseBody <$> req POST serverUrl (ReqBodyJson $ GQLQuery q) jsonResponse mempty
-    where q = "{ documents(filters: []) { results { id date semester publicComment downloadable faculty { id displayName } lectures { id displayName } } } }"
+getAllDocuments :: Req (Either [GQLError] [Document])
+getAllDocuments = fmap unDocuments <$> replyToEither <$> responseBody <$> req POST serverUrl (ReqBodyJson $ GQLQuery q) jsonResponse mempty
+    where q = "{ documents(filters: []) { results { id date semester publicComment downloadable faculty { id displayName } lectures { id displayName aliases } } } }"
+
+-- Mutations
+
+data LoginResult = LoginResult { unLoginResult :: Credentials }
+    deriving (Show)
+
+instance FromJSON LoginResult where
+    parseJSON = withObject "LoginResult" $ \v -> LoginResult
+        <$> v .: "login"
+
+data Credentials = Credentials
+    { credentialsToken :: Text
+    , credentialsUser  :: User
+    } deriving (Show)
+
+instance FromJSON Credentials where
+    parseJSON = withObject "Credentials" $ \v -> Credentials
+        <$> v .: "token"
+        <*> v .: "user"
+
+data User = User
+    { userUsername    :: Text
+    , userDisplayName :: Text
+    } deriving (Show)
+
+instance FromJSON User where
+    parseJSON = withObject "User" $ \v -> User
+        <$> v .: "username"
+        <*> v .: "displayName"
+
+login :: Text -> Text -> Req (Either [GQLError] Credentials)
+login username password = fmap unLoginResult <$> replyToEither <$> responseBody <$> req POST serverUrl (ReqBodyJson $ GQLQueryWithVars q vars) jsonResponse mempty
+    where q = "mutation LoginUser($username: String!, $password: String!) { login(username: $username, password: $password) { ... on Credentials { token user { username displayName } } } }"
+          vars = object
+            [ "username" .= username
+            , "password" .= password
+            ]