This repository has been archived by the owner on May 23, 2019. It is now read-only.
forked from ArnoVanLumig/azurify
-
Notifications
You must be signed in to change notification settings - Fork 0
/
azurify.hs
158 lines (144 loc) · 8.98 KB
/
azurify.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
{-# LANGUAGE OverloadedStrings, DeriveDataTypeable #-}
module Main where
import qualified Azure as Az
import Control.Monad.IO.Class (liftIO)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as L
import System.Console.CmdArgs
import System.Directory(getCurrentDirectory)
data Commands = UploadBlob { uploadBlobPath :: String
, uploadBlobStorageName :: String
, uploadBlobContainerName :: String
, uploadBlobFileName :: String
, uploadBlobContentType :: Maybe String
, uploadBlobContentEncoding :: Maybe String
, uploadBlobContentLanguage :: Maybe String
, uploadBlobContentCache :: Maybe String
}
| DeleteBlob { deleteBlobStorageName :: String
, deleteBlobContainerName :: String
, deleteBlobBlobName :: String
}
| DownloadBlob { downloadBlobStorageName :: String
, downloadBlobContainerName :: String
, downloadBlobBlobName :: String
}
| CreateContainer { createContainerStorageName :: String
, createContainerContainerName :: String
, createContainerACL :: Maybe String
}
| DeleteContainer { deleteContainerStorageName :: String
, deleteContainerContainerName :: String
, deleteContainerForce :: Maybe Bool
}
| ListContainer { listContainerStorageName :: String
, listContainerContainerName :: String
}
| BreakBlobLease { breakLeaseStorageName :: String
, breakLeaseContainerName :: String
, breakLeaseBlobName :: String
}
deriving (Show, Data, Typeable, Eq)
uploadBlob = UploadBlob { uploadBlobPath = def &= typ "file" &= argPos 0
, uploadBlobStorageName = def &= typ "accountname" &= argPos 1
, uploadBlobContainerName = def &= typ "containername" &= argPos 2
, uploadBlobFileName = def &= typ "blobname" &= argPos 3
, uploadBlobContentType = def &= name "contenttype"
, uploadBlobContentEncoding = def &= name "contentencoding"
, uploadBlobContentLanguage = def &= name "contentlanguage"
, uploadBlobContentCache = def &= name "cachecontrol"
} &= help "Upload a blob"
downloadBlob = DownloadBlob { downloadBlobStorageName = def &= typ "accountname" &= argPos 0
, downloadBlobContainerName = def &= typ "containername" &= argPos 1
, downloadBlobBlobName = def &= typ "blobname" &= argPos 2
} &= help "Download a blob"
deleteBlob = DeleteBlob { deleteBlobStorageName = def &= typ "accountname" &= argPos 0
, deleteBlobContainerName = def &= typ "containername" &= argPos 1
, deleteBlobBlobName = def &= typ "blobname" &= argPos 2
} &= help "Delete a blob"
breakBlobLease = BreakBlobLease { breakLeaseStorageName = def &= typ "accountname" &= argPos 0
, breakLeaseContainerName = def &= typ "containername" &= argPos 1
, breakLeaseBlobName = def &= typ "blobname" &= argPos 2
}
listContainer = ListContainer { listContainerStorageName = def &= typ "accountname" &= argPos 0
, listContainerContainerName = def &= typ "containername" &= argPos 1
} &= help "List all blobs in a container"
createContainer = CreateContainer { createContainerStorageName = def &= typ "accountname" &= argPos 0
, createContainerContainerName = def &= typ "containername" &= argPos 1
, createContainerACL = def &= typ "blobpublic|containerpublic|private" &= argPos 2
} &= help "Create a container with the specified access control"
deleteContainer = DeleteContainer { deleteContainerStorageName = def &= typ "accountname" &= argPos 0
, deleteContainerContainerName = def &= typ "containername" &= argPos 1
, deleteContainerForce = def &= name "force"
} &= help "Delete the container and all the blobs inside it"
mode = cmdArgsMode $ modes [uploadBlob, downloadBlob, deleteBlob, breakBlobLease, listContainer, createContainer, deleteContainer] &= help "Access the Azure blob storage" &= program "azurify" &= summary "Azurify v1.0"
main :: IO ()
main = do
m <- cmdArgsRun mode
putStrLn "Please enter your authkey:"
azureKey <- B.getLine
case m of
UploadBlob path account container name contType contEnc contLang contCache -> do
contents <- B.readFile path
res <- Az.createBlob (B8.pack account)
azureKey (B8.pack container)
(Az.BlobSettings (B8.pack name)
(B8.pack `fmap` contType)
(B8.pack `fmap` contEnc)
(B8.pack `fmap` contLang)
Nothing
(B8.pack `fmap` contCache)
Az.BlockBlob
Nothing
(Just contents)
)
case res of
Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err
Nothing -> return ()
DownloadBlob account container blobname -> do -- TODO: progress indicator
pwd <- getCurrentDirectory
res <- Az.getBlob (B8.pack account) azureKey (B8.pack container) (B8.pack blobname)
let path = pwd ++ "/" ++ blobname
putStrLn path
case res of
Left (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err
Right content -> L.writeFile path content
DeleteBlob account container blobname -> do
res <- Az.deleteBlob (B8.pack account) azureKey (B8.pack container) (B8.pack blobname)
case res of
Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err
_ -> return ()
BreakBlobLease account container blobname -> do
res <- Az.breakLease (B8.pack account) azureKey (B8.pack container) (B8.pack blobname)
case res of
Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err
_ -> return ()
ListContainer account container -> do -- TODO: output formatting
res <- Az.listContainer (B8.pack account) azureKey (B8.pack container)
case res of
Left (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err
Right blobs -> mapM_ print blobs
CreateContainer account container access -> do
let acl = case access of {
Just "blobpublic" -> Az.BlobPublic;
Just "containerpublic" -> Az.ContainerPublic;
Just "private" -> Az.Private;
Nothing -> Az.Private;
_ -> error "invalid access control specified";
}
res <- Az.createContainer (B8.pack account) azureKey (B8.pack container) acl
case res of
Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err
Nothing -> return ()
DeleteContainer account container force -> do
if force == (Just True) then do
res <- Az.listContainer (B8.pack account) azureKey (B8.pack container)
case res of
Left (stat, err) -> putStrLn "error listing container" >> print stat >> putStrLn "\n" >> print err
Right (x:_) -> error "Container not empty, use --force to ignore"
else do
res <- Az.deleteContainer (B8.pack account) azureKey (B8.pack container)
case res of
Just (stat, err) -> putStrLn "error" >> print stat >> putStrLn "\n" >> print err
Nothing -> return ()