azure-acs 0.0.1.0 → 0.0.1.1

raw patch · 4 files changed

+160/−7 lines, 4 filesdep +networkPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

Dependencies added: network

API changes (from Hackage documentation)

Files

• Network/MicrosoftAzure/ACS.hs +132/−0
• Web/WindowsAzure/ACS.hs +6/−2
• azure-acs.cabal +14/−3
• examples/Example.hs +8/−2

@@ -0,0 +1,132 @@+-- |+-- Module : Network.MicrosoftAzure.ACS+-- Description : API for requesting password token from Windows Azure ACS.+-- Copyright : (c) Hemanth Kapila, 2014+-- License : BSD3+-- Maintainer : saihemanth@gmail.com+-- Stability  : Experimental+--+-- Provides API to request password token from WindowsAzure ACS. The security token is needed by web applications and services that handle authentication using ACS.+-- Please refer to <http://msdn.microsoft.com/en-us/library/hh278947.aspx ACS Management Service API> for further information on ACS.+--+-- Following piece of code illustrates the use of API+--+-- @+-- import Network.MicrosoftAzure.ACS+-- import Network.HTTP.Conduit+-- import Network.HTTP.Client.Conduit+-- import Network.Connection (TLSSettings (..))+-- import qualified Data.ByteString.Char8 as C+--+-- main = do+--      acsCtx <- acsContext (AcsInfo "blahblah-sb" (C.pack "http://blahblah.servicebus.windows.net/" ) (C.pack "owner") (C.pack "blahBlahBlahBlah"))+--      manager <- newManagerSettings (mkManagerSettings (TLSSettingsSimple True False False) Nothing)+--      t1 <- acsToken manager acsCtx+--      print t1+-- @+--+module Network.MicrosoftAzure.ACS (+  -- * Types+  -- * Acs Info+  AcsInfo (..),+  -- * Acs Context+  AcsContext,+  AcsToken,+  -- * functions+  acsContext,+  acsToken+  )where++import Network.HTTP.Conduit+import Data.Conduit+import Network.HTTP.Types.URI+import qualified Data.ByteString.Char8 as C+import qualified Data.Attoparsec.ByteString.Lazy as AP+import Data.Attoparsec.ByteString.Char8+import Control.Concurrent.MVar+import Network.HTTP.Types.Method(methodPost)+import Network.HTTP.Types.Header+import Data.Time.Clock(getCurrentTime, addUTCTime,UTCTime)+import Data.Conduit.Attoparsec(sinkParser)+import Data.Conduit.Binary(sourceLbs)+import Network(withSocketsDo)++-- | 'AcsInfo' encapsulates the information needed to get the token from Azure ACS:+--+--+--     *  acs namespace+--     *  the relying party address+--     *  the issuer and+--     *  the issuer key.+data AcsInfo = AcsInfo String !C.ByteString !C.ByteString !C.ByteString+                 deriving (Eq,Show)++{- | synonym for the ACS password token+-}+type AcsToken = Header++data AcsResponse = AcsResponse !AcsToken !UTCTime+                   | NotConnectedToAcs+++{- | An abstract datatype that keeps track of acs token expiry and gets a new one as necessary.+-}+data AcsContext = AcsContext  !AcsInfo (MVar AcsResponse)++++-- | construct the context object. This call does not perform any network call yet.+acsContext :: AcsInfo -> IO AcsContext+acsContext a = do+  b <- newMVar NotConnectedToAcs+  return $ AcsContext a b+++{-# INLINE canReuse #-}+canReuse :: UTCTime -> AcsResponse -> Bool+canReuse _ NotConnectedToAcs = False+canReuse currentTime (AcsResponse _ time) = currentTime < time++{-# INLINE wrapToken #-}+wrapToken :: AcsResponse -> AcsToken+wrapToken (AcsResponse t _) = t+wrapToken _ = undefined++-- | If a valid token is available, it is returned. Otherwise, requests password a fresh password token from  windows azure acs+--+--  Refer to <http://www.yesodweb.com/book/http-conduit  HTTP Conduit> for information about creating and using 'Manager'+acsToken :: Manager -> AcsContext -> IO AcsToken+acsToken manager (AcsContext info mv) = do+  utcTime <- getCurrentTime+  acsResp <- takeMVar mv+  if canReuse utcTime acsResp+     then do { putMVar mv acsResp; return (wrapToken acsResp)}+    else do+    resp <- doAcsPost info manager+    putMVar mv resp+    return (wrapToken resp)++++doAcsPost :: AcsInfo -> Manager  ->IO AcsResponse+doAcsPost (AcsInfo url endpoint issuer key) manager = do+  request' <- parseUrl ("https://" ++ url ++ ".accesscontrol.windows.net/WRAPv0.9/")+  let request = addBody  $ request' {+             method = methodPost+           }+  res <- withSocketsDo $  httpLbs request manager+  utcTime <- getCurrentTime+  acsResp <- sourceLbs (responseBody res) $$ (sinkParser $ parseResponse utcTime)+  return acsResp+ where+   addBody = urlEncodedBody [(C.pack "wrap_scope",endpoint),(C.pack "wrap_name", issuer),(C.pack "wrap_password",key)]+   parseResponse currTime = do+     AP.takeTill (== 61)+     AP.anyWord8+     b1 <- AP.takeTill (== 38)+     AP.anyWord8+     AP.takeTill (== 61)+     AP.anyWord8+     i <- decimal+     return $ AcsResponse (toHeader b1) (addUTCTime (fromInteger $ i - 300) currTime)+   toHeader bs = (hAuthorization, C.concat [(C.pack  "WRAP access_token=\""), (urlDecode False bs), C.pack "\""])

@@ -1,11 +1,14 @@ -- | -- Module : Web.WindowsAzure.ACS--- Description : API for requesting password token from Windows Azure ACS. +-- Description : __Deprecated__ API for requesting password token from Windows Azure ACS.  -- Copyright : (c) Hemanth Kapila, 2014 -- License : BSD3 -- Maintainer : saihemanth@gmail.com -- Stability  : Experimental --+--  +-- __ DEPRECATED __  Use "Network.MicrosoftAzure.ACS" instead.+-- -- Provides API to request password token from WindowsAzure ACS. The security token is needed by web applications and services that handle authentication using ACS. -- Please refer to <http://msdn.microsoft.com/en-us/library/hh278947.aspx ACS Management Service API> for further information on ACS. --@@ -51,6 +54,7 @@ import Data.Time.Clock(getCurrentTime, addUTCTime,UTCTime) import Data.Conduit.Attoparsec(sinkParser) import Data.Conduit.Binary(sourceLbs)+import Network(withSocketsDo)  -- | 'AcsInfo' encapsulates the information needed to get the token from Azure ACS: --@@ -115,7 +119,7 @@   let request = addBody  $ request' {              method = methodPost            }-  res <-  httpLbs request manager+  res <- withSocketsDo $  httpLbs request manager   utcTime <- getCurrentTime   acsResp <- sourceLbs (responseBody res) $$ (sinkParser $ parseResponse utcTime)   return acsResp

@@ -2,10 +2,11 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                azure-acs-version:             0.0.1.0+version:             0.0.1.1 synopsis:            Windows Azure ACS  description:         Haskell wrappers  over REST API for <http://msdn.microsoft.com/en-us/library/hh147631.aspx Windows Azure Active Directory Access Control>. +                     .                      Currently only API that is supported is the one to request a password token from ACS via the <http://msdn.microsoft.com/en-us/library/hh674475.aspx OAuth WRAP  protocol>  homepage:            https://github.com/kapilash/hs-azure license:             BSD3@@ -21,10 +22,20 @@   library-  exposed-modules:     Web.WindowsAzure.ACS+  exposed-modules:     Web.WindowsAzure.ACS,+                       Network.MicrosoftAzure.ACS   -- other-modules:          -- other-extensions:    -  build-depends:       base >= 4 && <5 , bytestring,conduit,conduit-extra,http-conduit,attoparsec,http-types,time,connection+  build-depends:       base >= 4 && <5 , +                       bytestring,+                       conduit,+                       conduit-extra,+                       http-conduit,+                       attoparsec,+                       http-types,+                       time,+                       connection,+                       network   -- hs-source-dirs:         default-language:    Haskell2010   ghc-options:         -Wall -fwarn-tabs -funbox-strict-fields  -fno-warn-unused-do-bind

@@ -1,14 +1,20 @@ module Main where -import Webbaau.WindowsAzure.ACS +import Network.MicrosoftAzure.ACS  import Network.HTTP.Conduit import Network.HTTP.Client.Conduit import Network.Connection (TLSSettings (..)) import qualified Data.ByteString.Char8 as C import Control.Concurrent ++acsNS = "XXXX"+issuerKey = C.pack "YYYYYYYYYYYYYYYYYYYYYYY=="+issuerName = C.pack "owner"+relyingPartyUrl = C.pack "http://XXXX.servicebus.windows.net" + main = do-  acsCtx <- acsContext (AcsInfo "-sb" (C.pack "http://blahblah.servicebus.windows.net/" ) (C.pack "owner") (C.pack "basjasj="))+  acsCtx <- acsContext (AcsInfo acsNS relyingPartyUrl issuerName issuerKey)   manager <- newManagerSettings (mkManagerSettings (TLSSettingsSimple True False False) Nothing)   forkIO (acsToken manager acsCtx >>= print)   t1 <- acsToken manager acsCtx