From e9ea90182193cb6a813244bc676a8fe2f573fa29 Mon Sep 17 00:00:00 2001 From: Kjetil Orbekk Date: Sun, 11 Oct 2015 13:51:32 -0400 Subject: Add Authentication module. --- photos.cabal | 1 + src/Authentication.hs | 31 +++++++++++++++++++++++++++++++ src/Main.hs | 9 +++++---- 3 files changed, 37 insertions(+), 4 deletions(-) create mode 100644 src/Authentication.hs 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 ()) -- cgit v1.2.3