auth client ok

.gitignore

@@ -1,2 +1,5 @@
 /.stack-work
 /dist
+/*.iml
+/out
+/.idea

kreg.cabal

@@ -2,11 +2,11 @@ name:                kreg
 version:             0.1.0.0
 synopsis:            Initial project template from stack
 description:         Please see README.md
-homepage:            https://github.com/Daroth/kreg#readme
+homepage:            https://github.com/manuelleduc/kreg-haskell#readme
 license:             BSD3
 license-file:        LICENSE
-author:              Daroth
-maintainer:          [email protected]
+author:              Manuel Leduc
+maintainer:          [email protected]
 copyright:           beerware
 category:            draft
 build-type:          Simple
@@ -17,6 +17,10 @@ library
   hs-source-dirs:      src
   exposed-modules:     Lib
   build-depends:       base >= 4.7 && < 5
+                     , wreq
+                     , http-client
+                     , aeson
+                     , lens
   default-language:    Haskell2010
 
 executable kreg-exe
@@ -27,6 +31,7 @@ executable kreg-exe
                      , kreg
                      , optparse-generic
                      , haskeline
+
   default-language:    Haskell2010
 
 test-suite kreg-test
@@ -40,4 +45,4 @@ test-suite kreg-test
 
 source-repository head
   type:     git
-  location: https://github.com/Daroth/kreg
+  location: https://github.com/manuelleduc/kreg-haskell

src/Lib.hs

@@ -2,5 +2,7 @@ module Lib
     ( someFunc
     ) where
 
+import Registry.Client (auth)
+
 someFunc :: IO ()
 someFunc = putStrLn "someFunc"

src/Registry/Client.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Registry.Client (auth, AuthResponseBody(..)) where
+
+import GHC.Generics
+import Data.Aeson
+import qualified Network.Wreq as R
+import Control.Lens ((^?))
+import Control.Exception as E
+import Network.HTTP.Client (HttpException(StatusCodeException))
+
+data Auth = Auth {
+    username :: String,
+    password :: String,
+    rememberMe :: Bool
+} deriving (Generic)
+
+data AuthResponseBody = AuthResponseBody {
+    id_token :: String
+} deriving (Generic, Show)
+
+instance ToJSON Auth
+instance FromJSON AuthResponseBody
+
+baseUrlServer = "http://localhost:8080/"
+authenticateResource = baseUrlServer ++ "api/authenticate"
+
+--auth :: String -> String -> IO (Maybe AuthResponseBody)
+auth login password =
+    let handler e@(StatusCodeException _ _ _) = return Nothing
+        authObj = Auth login password False
+        operations = do r <- R.post authenticateResource (toJSON authObj)
+                        (body :: R.Response AuthResponseBody) <- R.asJSON r
+                        return (body ^? R.responseBody)
+    in operations `E.catch` handler