azure-acs (empty) → 0.0.1.0
raw patch · 5 files changed
+219/−0 lines, 5 filesdep +attoparsecdep +basedep +bytestringsetup-changed
Dependencies added: attoparsec, base, bytestring, conduit, conduit-extra, connection, http-conduit, http-types, time
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- Web/WindowsAzure/ACS.hs +135/−0
- azure-acs.cabal +35/−0
- examples/Example.hs +17/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2014, Hemanth Kapila++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Hemanth Kapila nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Web/WindowsAzure/ACS.hs view
@@ -0,0 +1,135 @@+-- |+-- Module : Web.WindowsAzure.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 Web.WindowsAzure.ACS +-- import Network.HTTP.Conduit +-- import Network.HTTP.Client.Conduit+-- import Network.Connection (TLSSettings (..))+-- import qualified Data.ByteString.Char8 as C+-- import Control.Concurrent+--+-- 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 Web.WindowsAzure.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)++-- | '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 <- 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 "\""])+ +
+ azure-acs.cabal view
@@ -0,0 +1,35 @@+-- Initial azure-acs.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: azure-acs+version: 0.0.1.0+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+license-file: LICENSE+author: Hemanth Kapila+maintainer: saihemanth@gmail.com+copyright: Hemanth Kapila (c) 2014+category: Web+build-type: Simple+extra-source-files: examples/*.hs+cabal-version: >=1.10++++library+ exposed-modules: Web.WindowsAzure.ACS+ -- other-modules: + -- other-extensions: + build-depends: base >= 4 && <5 , bytestring,conduit,conduit-extra,http-conduit,attoparsec,http-types,time,connection+ -- hs-source-dirs: + default-language: Haskell2010+ ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -fno-warn-unused-do-bind+ ghc-prof-options: -prof -auto-all++source-repository head+ type: git+ location: https://github.com/kapilash/hs-azure.git
+ examples/Example.hs view
@@ -0,0 +1,17 @@+module Main where++import Webbaau.WindowsAzure.ACS +import Network.HTTP.Conduit+import Network.HTTP.Client.Conduit+import Network.Connection (TLSSettings (..))+import qualified Data.ByteString.Char8 as C+import Control.Concurrent++main = do+ acsCtx <- acsContext (AcsInfo "-sb" (C.pack "http://blahblah.servicebus.windows.net/" ) (C.pack "owner") (C.pack "basjasj="))+ manager <- newManagerSettings (mkManagerSettings (TLSSettingsSimple True False False) Nothing)+ forkIO (acsToken manager acsCtx >>= print)+ t1 <- acsToken manager acsCtx+ print t1+ +