module Network.WindowsLive.App
    ( App
    , AppID
    , appId
    , new

    , decode
    , verifier
    )
where

import Control.Monad ( replicateM, liftM )
import Control.Monad.Error ( MonadError )
import qualified Text.ParserCombinators.Parsec as Parsec

import qualified Network.WindowsLive.Secret as Secret
import qualified Codec.Binary.Base64 as Base64
import qualified Codec.Encryption.AES as AES
import Codec.Encryption.Modes ( unCbc )
import Codec.Utils ( Octet, fromOctets, toOctets, listFromOctets )
import Control.Monad ( when )
import qualified Data.Digest.SHA256 as SHA256
import Data.HMAC ( hmac, HashMethod(..) )
import Data.LargeWord ( Word128 )
import Data.List.Split ( splitOn )
import Data.Time.Clock.POSIX ( POSIXTime )
import Network.URI ( unEscapeString )
import Data.URLEncoded ( (%=), (%&), URLEncoded )
import qualified Data.URLEncoded as URLEnc

-- |Create a new 'App', validating the Application ID and Secret key
new :: MonadError e m => String -> String -> m App
new appIdStr secretStr = do
  validateAppId appIdStr
  App appIdStr `liftM` Secret.new secretStr

validateAppId :: MonadError e m => String -> m ()
validateAppId = either (fail . show) (const $ return ()) .
                Parsec.parse (replicateM 16 Parsec.hexDigit) "appid"
-- |Visit
-- <https://lx.azure.microsoft.com/Cloud/Provisioning/Default.aspx> to
-- get your application's Application ID and Secret key
data App = App { appId :: AppID
               , secret :: Secret.Secret
               }

type AppID = String

encryptionKey :: App -> Secret.Key
encryptionKey = Secret.encryptionKey . secret

signingKey :: App -> Secret.Key
signingKey = Secret.signingKey . secret

-- |Decrypt a token (failing if it cannot be decrypted)
decodeOnly :: MonadError e m => App -> String -> m String
decodeOnly app tokStr = do
  -- First, the string is URL-unescaped and base64 decoded
  encryptedBytes <- u64 tokStr
  when (null encryptedBytes) $ fail "Missing initialization vector"
  when ((length encryptedBytes `mod` 16) /= 0) $
       fail "Attempted to decode invalid token"

  -- Second, the IV is extracted from the first 16 bytes of the string
  let initVector:encryptedBlocks = toBlocks encryptedBytes

      -- Finally, the string is decrypted using the encryption key
      key = fromOctets (256::Integer) $ encryptionKey app :: Word128
      decryptedBlocks = unCbc AES.decrypt initVector key encryptedBlocks

  return $ stripEOT $ toString decryptedBlocks

-- |Decode, validate, and parse a String containing x-www-urlencoded
-- |data encrypted with this application's secret
decode :: MonadError e m => App -> String -> m URLEncoded
decode app s = do
  decoded <- decodeOnly app s
  validate app decoded
  URLEnc.importString decoded

-- |decode a Base64 encoded, URL-escaped string into a sequence of bytes
u64 :: MonadError e m => String -> m [Octet]
u64 str =
    case Base64.decode $ unEscapeString str of
      Nothing -> fail "Data was not valid base64"
      Just bs -> return bs

-- |Check the signature of this token (failing if it is not valid)
validate :: MonadError e m => App -> String -> m ()
validate app tok = do
  (body, sig) <- case splitOn "&sig=" tok of
                   [b, s] -> return (b, s)
                   [_] -> fail $ "No sig found: " ++ show tok
                   unexpected ->
                       fail $ "More than one sig found: " ++ show unexpected

  extractedSig <- u64 sig
  let calculatedSig = sign app body
  when (extractedSig /= calculatedSig) $
       fail $ "Signature did not match: extracted=" ++ show extractedSig
                ++ " /= calculated=" ++ show calculatedSig

sign :: App -> String -> [Octet]
sign app = hmac (HashMethod SHA256.hash 512) (signingKey app) . toBytes

stripEOT :: String -> String
stripEOT = reverse . dropWhile (== '\EOT') . reverse

toBytes :: String -> [Octet]
toBytes = map (toEnum . fromEnum)

toString :: [Word128] -> String
toString = map (toEnum . fromEnum) . concatMap (toOctets (256::Integer))

toBlocks :: [Octet] -> [Word128]
toBlocks = reverse . listFromOctets . reverse

-- |Generate an application verifier to prove to the server that we
-- know the secret and application ID
verifier :: App -> POSIXTime -> URLEncoded
verifier app ts =
    let q = "appid" %= appId app %& "ts" %= show (round ts :: Integer)
        sig = Base64.encode $ sign app $ URLEnc.export q
    in q %& "sig" %= sig