Add Authentication module.

3 files changed, 37 insertions, 4 deletions

diff --git a/photos.cabal b/photos.cabal
index f953328..d0339bf 100644
--- a/photos.cabal
+++ b/photos.cabal
@@ -22,6 +22,7 @@ executable photos
   build-depends:
       base >= 4.7 && < 5
     , servant
+    , bytestring
     , servant-server
     , aeson
     , warp
diff --git a/src/Authentication.hs b/src/Authentication.hs
new file mode 100644
index 0000000..2908309
--- /dev/null
+++ b/src/Authentication.hs
@@ -0,0 +1,31 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TemplateHaskell #-}
+module Authentication (User, queryUser) where
+
+import Data.Aeson
+import GHC.Generics
+import Network.HTTP.Conduit
+import Data.ByteString.Lazy.Char8 (unpack)
+import Control.Exception
+
+makeUrl = ("https://www.googleapis.com/oauth2/v3/tokeninfo?id_token="++)
+
+data User = User
+  { email :: String
+  , name :: String
+  } deriving (Eq, Show, Generic)
+
+instance FromJSON User
+
+queryUser :: String -> IO (Maybe User)
+queryUser token = (queryUser' token) `catch` \e -> do
+  print (e :: HttpException)
+  return Nothing
+
+queryUser' token = do
+  response <- simpleHttp (makeUrl token)
+  return (decode response)
diff --git a/src/Main.hs b/src/Main.hs
index 75995fc..17e3d70 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -14,12 +14,14 @@ import Servant
 import HFlags
 import System.Exit
 import Control.Monad
-import Data
-import PhotoStore
 import Control.Monad.IO.Class
 import Control.Monad.Trans.Either
 import Network.Wai.Middleware.RequestLogger
 
+import Authentication
+import Data
+import PhotoStore
+
 defineFlag "port" (8081 :: Int) "Port to serve on"
 defineFlag "host" ("*6" :: String) "Host to serve on (*6 for ipv6 mode)"
 defineFlag "pending_path" ("" :: String) "Path to pending albums"
@@ -42,7 +44,7 @@ type PhotoApi =
   :<|> "test"   :> Header "X-Token" String :> Get '[JSON] ()
 -- Introduce request header containing auth information.
 
-config = Config 
+config = Config
   { pendingPath = flags_pending_path
   , photosPath = flags_photos_path
   }
@@ -51,7 +53,6 @@ server :: Server PhotoApi
 server = albums
     :<|> rename
     :<|> test
-
   where albums = liftIO (getAlbums config)
 
         rename :: RenameRequest -> EitherT ServantErr IO (Either RenameError ())